标签：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代码如下：
代码语言：javascript复制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。
