将事件代码添加到 PowerPoint 中的复选框 VBA

Question

我正在开发一个 PowerPoint 2010 平台，它向用户展示一系列页面，其中包含一条语句、一个复选框（从标签元素构建以启用更改复选框的大小）和 forward/back 上的箭头每页。

因为这将用于许多页面数量不同的项目，所以我正在使用 PowerPoint VBA 动态构建“平台”，以从包含列表的 Excel 电子表格动态构建页面个人陈述。

我已经能够编写 VBA 代码来打开 Excel 文件，将语句读入 PowerPoint 中的数组并构建适当数量的页面，其中包含页面上的所有元素页。至此一切正常。我遇到困难的地方是将点击操作分配给复选框。

这是页面构建例程调用的用于插入复选框的代码（显然在此之前还有更多代码用于访问 Excel 文件、创建页面和添加“声明”文本盒子......所有这些都有效）：

Sub AddSelectBox(Index As Integer, pptBuildingSlide As Slide)

'Add Checkbox
    With pptBuildingSlide.Shapes.AddOLEObject(Left:=342, Top:=294, Width:=42, Height:=42, ClassName:="Forms.Label.1")
        .Name = "label" & Index
        .OLEFormat.Object.Font.Name = "Wingdings 2"
        .OLEFormat.Object.Font.Charset = "2"
        .OLEFormat.Object.Caption = "£"
        .OLEFormat.Object.Font.Size = 40
    End With

'Add Checkbox Click Code
'(CODE FOR ADDING CLICK EVENT TO EACH BOX GOES HERE)

End Sub

每个页面上的复选框都有一个与页码对应的谨慎名称（例如 Label1、Label2 等）。我需要将以下代码添加到每个页面上的每个复选框以切换复选标记，以便稍后在程序中我可以通过读取“标题”属性来查看哪些被选中。（字体设置为“Wingdings 2”以在点击时给出一个空白框和一个选中框）

Private Sub Label1_Click()

   If Label1.Caption = "£" Then
       Label1.Caption = "R"
   Else
       Label1.Caption = "£"
   End If

End Sub

我在网上搜索了任何有关动态添加事件代码的参考资料，并找到了许多示例（例如 Assign on-click VBA function to a dynamically created button on Excel Userform），但几乎所有示例都是针对 Excel 或 Access 的。我应该指出，编码“不是我的日常工作”，我已经成功地阅读了“精通 Office 2003 VBA”和网络搜索……所以我将这些示例翻译成 PowerPoint 的能力不足.感谢您提供的任何帮助。

5/29 附加信息：
我发现 .CreateEventProc 方法是将代码写入 VBA 的一种方式。我找到的示例是为 Excel 在 this site 编写的。我已经做到了这一点（消息框代码将替换为点击代码，但我只是用它进行测试以避免引入其他错误）...

Sub CreateEventProcedure()
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim LineNum As Long
    Const DQUOTE = """" ' one " character

    Set VBProj = ActivePresentation.VBProject
    Set VBComp = VBProj.VBComponents(Slides(1))
    Set CodeMod = VBComp.CodeModule

    With CodeMod
        LineNum = .CreateEventProc("Click", "Label1")
        LineNum = LineNum + 1
        .InsertLines LineNum, "    MsgBox " & DQUOTE & "Hello World" & DQUOTE
    End With
End Sub

...但在 (slides(1)) 获得 "Compile Error: Sub or Function not defined"。任何清理它的帮助（如果它实际上是一个合适的解决方案）将不胜感激。

Answer 1

你必须使用标签吗？（我了解大小问题，但您可以添加一个更容易的形状。）

基于以下内容：这只有在您允许访问 Security 中的 VBE 时才有效（不能在代码中完成）

    Sub makeBox()
Dim strCode As String
With ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 10, 10, 20, 20)
.Fill.Visible = False
.Line.Visible = False
With .TextFrame.TextRange.Font
.Name = "Wingdings 2"
.Size = 40
.Color.RGB = vbBlack
End With
.TextFrame.TextRange = "£"
With .ActionSettings(ppMouseClick)
.Action = ppActionRunMacro
.Run = "chex"
End With
End With
strCode = "Sub chex(oshp As Shape)" & vbCrLf & "If oshp.TextFrame.TextRange =" & Chr(34) & "£" & Chr(34) & "Then" _
& vbCrLf & "oshp.TextFrame.TextRange = " & Chr(34) & "R" & Chr(34) & vbCrLf _
& "Else" & vbCrLf & "oshp.TextFrame.TextRange =" & Chr(34) & "£" & Chr(34) & vbCrLf & "End If" & vbCrLf & "End Sub"
With ActivePresentation.VBProject.VBComponents.Add(vbext_ct_StdModule)
.CodeModule.AddFromString (strCode)
End With
End Sub

将事件代码添加到 PowerPoint 中的复选框 VBA

Adding event code to checkbox in PowerPoint VBA

powerpoint

vba

dynamic

buttonclick