使用VBA让PPT成为记分牌

fanjy

发布于 2023-09-15 08:09:56

4360

发布于 2023-09-15 08:09:56

文章被收录于专栏：完美Excel

标签：VBA，PowerPoint编程

使用VBA，我们可以创建交互式的记分牌PPT，如下图1所示。

图1

我们先创建带有一个记分牌的简单幻灯片，如下图2所示，在幻灯片中放置一个ActiveX标签控件，用于显示分数，并插入两个形状，一个加分，一个减分。

图2

VBA代码如下：

Sub PlusOne()
 counter.Caption = counter.Caption + 1
End Sub
Sub MinusOne()
 counter.Caption = counter.Caption - 1
End Sub
Sub ExitAndReset()
 counter.Caption = 0
 ActivePresentation.SlideShowWindow.View.Exit
End Sub
Private Sub CommandButton1_Click()
 ExitAndReset
End Sub

单击功能区“插入”选项卡“链接”组中的“动作”按钮，将代表加分的形状关联PlusOne过程，代表减分的形状关联MinusOne过程。

还可以使用ActiveX的命令按钮控件，通过按左右箭头来加减分，幻灯片如下图3所示。

图3

VBA代码如下：

Private Sub CommandButton1_Click()
 counter.Caption = 0
End Sub
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)
 If (KeyCode = vbKeyRight) Then
   counter.Caption = counter.Caption + 1
 End If
 If (KeyCode = vbKeyLeft) Then
   counter.Caption = counter.Caption - 1
 End If
End Sub

还可以在一张幻灯片中设置多个记分牌，如下图4所示。

图4

相对应的VBA代码如下：

Sub Label1Plus2()
 Label1.Caption = Label1.Caption + 2
End Sub
Sub Label1Plus1()
 Label1.Caption = Label1.Caption + 1
End Sub
Sub Label1Minus1()
 Label1.Caption = Label1.Caption - 1
End Sub
Sub Label1Reset()
 Label1.Caption = 0
End Sub
Sub Label2Plus2()
 Label2.Caption = Label2.Caption + 2
End Sub
Sub Label2Plus1()
 Label2.Caption = Label2.Caption + 1
End Sub
Sub Label2Minus1()
 Label2.Caption = Label2.Caption - 1
End Sub
Sub Label2Reset()
 Label2.Caption = 0
End Sub
Sub Label3Plus2()
 Label3.Caption = Label3.Caption + 2
End Sub
Sub Label3Plus1()
 Label3.Caption = Label3.Caption + 1
End Sub
Sub Label3Minus1()
 Label3.Caption = Label3.Caption - 1
End Sub
Sub Label3Reset()
 Label3.Caption = 0
End Sub
Sub ExitPPT()
 ActivePresentation.SlideShowWindow.View.Exit
End Sub
Sub Reset()
 Label1.Caption = 0
 Label2.Caption = 0
 Label3.Caption = 0
End Sub

当然，也可以让多张幻灯片中的记分牌同步，如下图5所示。在这多张幻灯片中，使用的是形状来代表记分牌和加减分，并且命名统一。

图5

对应的VBA代码如下：

Dim counter As TextRange
Sub counterReset()
 Dim i As Integer
 On Error Resume Next
 For i = 1 To 4
  Set counter = ActivePresentation.Slides(i).Shapes("counter1").TextFrame.TextRange
  counter = 0
  Set counter = ActivePresentation.Slides(i).Shapes("counter2").TextFrame.TextRange
  counter = 0
 Next i
End Sub
Sub
counter1Add()
 Dim i As Integer
 On Error Resume Next
 For i = 1 To 4
   Set counter = ActivePresentation.Slides(i).Shapes("counter1").TextFrame.TextRange
   counter = Int(counter) + 1
 Next i
End Sub
Sub counter1Sub()
 Dim i As Integer
 On Error Resume Next
 For i = 1 To 4
   Set counter = ActivePresentation.Slides(i).Shapes("counter1").TextFrame.TextRange
   counter = Int(counter) - 1
 Next i
End Sub
Sub counter2Add()
 Dim i As Integer
 On Error Resume Next
 For i = 1 To 4
   Set counter = ActivePresentation.Slides(i).Shapes("counter2").TextFrame.TextRange
   counter = Int(counter) + 1
 Next i
End Sub
Sub counter2Sub()
 Dim i As Integer
 On Error Resume Next
 For i = 1 To 4
   Set counter = ActivePresentation.Slides(i).Shapes("counter2").TextFrame.TextRange
   counter = Int(counter) - 1
 Next i
End Sub

有兴趣的朋友可以根据上面的情形，结合实际设计自己的记分牌。

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2023-09-07 05:30，如有侵权请联系 cloudcommunity@tencent.com 删除

vba