在编辑模式下单击powerpoint形状时运行宏

时间:2014-03-12 13:37:31

标签: vba powerpoint-vba mouseclick-event

我希望能够在点击它时更改某个形状的某些值。但是我想在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

使用此代码可以单击幻灯片放映模式下的形状并运行Identify()方法。我想在编辑模式下做同样的事情,所以当演示文稿没有运行时。这可能吗?

2 个答案:

答案 0 :(得分:0)

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

发布的代码没有多大意义。也许重新开始,只是说当你的形状被克隆时你想要发生的是什么(在展示模式下)

答案 1 :(得分:0)

有可能这样做,我现在就自己做,您所需要的就是下载此文件 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

结束子

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

将cPPTObject设为新的Class1

将TrapFlag设为布尔值

 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

现在运行TrapEvents,只要您单击带有文本的形状,您的子控件就会运行 归功于撰写此http://www.officeoneonline.com/eventgen/eventgen.html

的人