当我在编辑模式下单击PowerPoint形状时,运行宏



我希望在单击它时能够更改某些形状的值。但是我想在PowerPoint处于编辑模式时(我不知道是否这样说),而不是在幻灯片显示模式下进行。我一直在寻找互联网,我只找到了一种在幻灯片显示模式下进行的方法,所以当演示文稿正在运行时。

这是我找到的代码

Private Sub createSwipeNext(color)
    Dim swipArrow As Shape
    Dim subName As String
    subName = "Identify"
    Set cSlide = Application.ActiveWindow.View.Slide
    'ActiveWindow.Selection.Unselect
    Set swipArrow = cSlide.Shapes.AddShape(msoShapeRightArrow, ActivePresentation.SlideMaster.width + 10, ActivePresentation.SlideMaster.height / 2, 40, 30)
    If color = "green" Then
        swipArrow.Fill.ForeColor.RGB = vbGreen
    Else
        swipArrow.Fill.ForeColor.RGB = vbRed
    End If
    swipArrow.name = "Dink swipe arrow"
    'swipArrow.ActionSettings(ppMouseClick).Run = subName
    With swipArrow.ActionSettings(ppMouseClick) ' or ppMouseOver if you prefer
         .Run = subName
         .Action = ppActionRunMacro
      End With
 End Sub

使用此代码可以单击幻灯片显示模式上的形状,然后运行识别()方法。我想进行相同的功能,但在编辑模式下,因此当演示文稿不运行时。这可能吗?

可能,但绝对不容易。您需要编写一个类模块来检测选择事件。

发布的代码没有很多意义。也许重新开始,然后说您想在形状clcik的情况下(在显示模式下)

态http://www.officeoneonline.com/eventgen/eventgen20.zip安装它创建一个类模块粘贴此代码选项显式
Public WithEvents PPTEvent As Application

Private Sub Class_Initialize()
End Sub

Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
If Sel.Type = ppSelectionShapes Then
    If Sel.ShapeRange.HasTextFrame Then
        If Sel.ShapeRange.TextFrame.HasText Then
           If Trim(Sel.ShapeRange.TextFrame.TextRange.Text) = "Text inside your shape" Then
              Sel.Unselect
              yoursub
           End If
       End If
     End If
   End If

结束子

插入一个新模块粘贴此代码

dim cpptObject作为新class1

昏暗的陷阱作为布尔

 Sub TrapEvents()
      If TrapFlag = True Then
         MsgBox "Already Working"
         Exit Sub
      End If
    Set cPPTObject.PPTEvent = Application
    TrapFlag = True
 End Sub


 Sub ReleaseTrap()
      If TrapFlag = True Then
         Set cPPTObject.PPTEvent = Nothing
         Set cPPTObject = Nothing
         TrapFlag = False
      End If
 End Sub
 Sub yoursub()
         MsgBox "Your Sub is working"
 End Sub

现在运行弹跳者,当您在任何地方单击形状时,该文本中的子将运行学分写给撰写此http://www.officeoneonline.com/eventgen/eventgen.html

的人

最新更新