使用VBA创建一份答题PPT（续2），附示例下载

fanjy

发布于 2023-08-30 08:37:02

2830

发布于 2023-08-30 08:37:02

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

标签：VBA，PowerPoint编程

前面的文章：

使用VBA创建一份答题PPT

使用VBA创建一份答题PPT（续1）

下面，我们让每张幻灯片可以有多个空供学生填写答案。

很简单，有多少空就添加多个ActiveX文本框控件，然后在幻灯片外面也添加相应的文本框控件，并且让每个在空中输入的答案与幻灯片外的正确答案相对应。

将幻灯片中的控件以“AA1”、“AA2”……等命名，将幻灯片外的控件以对应的“CA1”、“CA2”……等命名，然后将代码进行相应的调整，如果每张幻灯片中有4个空，那么可使用For循环，遍历这4个空中的内容与正确的答案核对。

此外，在多张幻灯片中将形状名称从“CA”更改为“CA1”可能非常繁琐。因此，可以使用一个简单的VBA宏代码，允许我们重命名形状的名称：

在循环过程中，每当”AA”&i等于”CA”&i时，我们将“CorrectBlanks”整数的值增加1。

还将NoOfBlanks的值设置为等于i。

这样，上述整数不断更新，直到出现一个错误，说明形状”AA”&i不存在。

此时，转到VBA宏中的CheckIfAllCorrect过程，然后添加一个If条件。

如果空的数量等于CorrectBlanks的数量，那么可以成功地移到下一个问题。

一旦发生这种情况，可以将CorrectBlanks的值重置为0。

完整的VBA代码如下：

Sub Initialise()
 Dim i As Long
 Dim a As Long
 
 For i = 2 To 3 '可根据实际调整数量
   For a = 1 To 20 '空的最大数量
     On Error Resume Next
     ActivePresentation.Slides(i).Shapes("AA" & a).OLEFormat.Object.Value = ""
   Next a
 Next i
 ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub CheckAnswer()
  Dim CS As Slide '代表当前幻灯片
  Set CS = ActivePresentation.SlideShowWindow.View.Slide
  Dim CorrectBlanks As Integer
  CorrectBlanks = 0
  Dim i As Integer
  Dim NoOfBlanks As Integer
 
  For i = 1 To 10
    On Error GoTo CheckIfAllCorrect
    If UCase(CS.Shapes("AA" & i).OLEFormat.Object.Value) = UCase(CS.Shapes("CA" & i).OLEFormat.Object.Value) Then
      MsgBox "答案正确", vbInformation, "答案 " & i
      CorrectBlanks = CorrectBlanks + 1
    Else
      MsgBox "答案错误. 请重试!", vbCritical, "答案" & i
    End If
    NoOfBlanks = i
  Next i
CheckIfAllCorrect:
  If CorrectBlanks = NoOfBlanks Then
    ActivePresentation.SlideShowWindow.View.Next
  End If
End Sub

有兴趣的朋友，可以在完美Excel微信公众号中发送消息：

FillBlanksPPT

获取本文示例PPT下载链接。

或者，直接到知识星球App完美Excel社群下载本文示例PPT。

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

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

vba