修改程序，自选图形设置跳转动作无果
幻灯片停止放映的时，在第一张指定位置，插入一个autoshape、名为“转X”的按钮（x为停止放映的幻灯片的序号），并给这个按钮设置动作，以便在下次接着放映的时候，单击这个按钮自动跳转到x张幻灯片。 附件如下，请查阅。请求高人、大侠一助，谢谢了！！ 再次求救，再次等候，希望得到指教。 删除原有代码，使用下面的代码：
[*]
[*]Private Const ShapeNAME As String = "Title 1"
[*]
[*]Sub OnSlideShowPageChange()
[*] Dim Shape As Shape
[*] Dim SlideIndex As Long
[*]
[*] On Error Resume Next
[*]
[*] SlideIndex = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
[*] If SlideIndex > 1 Then
[*] Set Shape = ActivePresentation.Slides(1).Shapes(ShapeNAME)
[*] With Shape
[*] .TextEffect.Text = "前往第" & SlideIndex & "页"
[*]
[*] With .ActionSettings(ppMouseClick)
[*] If (.Action <> ppActionRunMacro) Or (.Run <> "Button_Click") Then
[*] .Action = ppActionRunMacro
[*] .Run = "Button_Click"
[*] End If
[*] End With
[*] End With
[*] End If
[*]End Sub
[*]
[*]Sub Button_Click()
[*] Dim Shape As Shape
[*] Dim SlideIndex As Long
[*]
[*] On Error Resume Next
[*]
[*] SlideIndex = Val(Mid(ActivePresentation.Slides(1).Shapes(ShapeNAME).TextEffect.Text, 4))
[*]
[*] If SlideIndex > 1 Then
[*] ActivePresentation.SlideShowWindow.View.GotoSlide SlideIndex
[*] End If
[*]End Sub
复制代码 万分欣喜，万分感谢。
困扰多时的问题再次得到你的指点。
谢谢！谢谢！！谢谢！！！
先拜读，一饱眼福；再测试，感受恩赐。 还是要请教你：
（1）停止放映的时候，没有在第一张幻灯片自动建立跳转的按钮。因为在过程中，没有出现“AddShape”方法。
（2）停止播放时的事件是：“OnSlideShowTerminate"，这是一个自动宏，如果代码不置于这个自动宏之下，能自动生成跳转按钮吗？
请先生教我。
再谢了。 joforn：ShapeNAME新建的过程呢？ 我一开始也准备用"OnSlideShowTerminate"，这样的话方便很多，但在测试的时候发现很多时候结束播放的时候并没有激活这个事件，所以才改成了用另一个事件。
另外，我觉得并不需要每次都去新建一个Shape，只要自己事件定义好一个Shape就行了。 啊，是这样，也是的，只不过，我也觉得ppt中的事件不好使：
（1）、一是不稳定。即使是代码无误，也会因为它在过程中的位置的不同，有时也没有反应。
（2）、能用的事件极少。好像只有四个：
OnSlideShowTerminate
onslideshowpagechang
前翻
后翻
不知是不是这样。
希望得到指教。
另外这段代码，我想进行一下变动，以适应我的模板界面，如果有问题，还会请教你，希望不吝赐教。
页:
[1]
2