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

fanjy

发布于 2023-08-30 08:36:41

2740

发布于 2023-08-30 08:36:41

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

标签：VBA，PowerPoint编程

上一篇文章：

使用VBA创建一份答题PPT

接下来，我们进一步完善我们的问题填空测验PPT。

我们在问题测试结束后添加一张幻灯片，用于展示答对的题目数量、答错的题目数量和没有回答的题目数量。

这可以使用ActiveX的标签控件，示例如下图7所示。

图7

在测试时，只计算第一次的回答，也就是说，第一次回答正确计入回答正确的题数，如果第一次回答错误，即便后面回答正确，也计入回答错误的题数。

另外，在测试时，我们将限制每个问题的答题时间。超过这个设定的时间，如果你还未回答出来，会自动进入到下一道题目。选择问题幻灯片，单击功能区“切换”选项卡，在“计时”组中选取“设置自动换片时间”为10秒，如下图8所示。

图8

下面是完整的VBA代码：

Dim QuestionAttempted As Boolean

Sub Initialise()
 Dim i As Long
 
 QuestionAttempted = False
 Slide4.CA.Caption = 0
 Slide4.WA.Caption = 0
 Slide4.UA.Caption = 0
 
 For i = 2 To 3 '可根据实际调整数量
   ActivePresentation.Slides(i).Shapes("AA").OLEFormat.Object.Value = ""
 Next i
 ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub CheckAnswer()
 '在幻灯片演示模式时查找当前幻灯片编号
 Dim CurrentSlideNo As Integer
 CurrentSlideNo = ActivePresentation.SlideShowWindow.View.Slide.SlideIndex
 Dim ErrorSlideNo As Integer
 
 '查找是否AA = CA
 If UCase(ActivePresentation.Slides(CurrentSlideNo).Shapes("AA").OLEFormat.Object.Value) = UCase(ActivePresentation.Slides(CurrentSlideNo).Shapes("CA").OLEFormat.Object.Value) Then
   MsgBox "答案正确"
   If ErrorSlideNo <> CurrentSlideNo Then QuestionAttempted = False
   If QuestionAttempted = False Then
     Slide4.CA.Caption = (Slide4.CA.Caption) + 1
   End If
   ActivePresentation.SlideShowWindow.View.GotoSlide (CurrentSlideNo + 1)
   QuestionAttempted = False
   CalculatedUnattemptedAnswer
 Else
   MsgBox "答案错误. 请重试!"
   If QuestionAttempted = False Then
     Slide4.WA.Caption = (Slide4.WA.Caption) + 1
   End If
   ErrorSlideNo = CurrentSlideNo
   QuestionAttempted = True
   CalculatedUnattemptedAnswer
 End If
End Sub

Sub CalculatedUnattemptedAnswer()
 Slide4.UA.Caption = (2) - (Slide4.CA.Caption) - (Slide4.WA.Caption)
End Sub

注意，因为我使用的示例只有2张问题幻灯片，所以计数为2，你可以根据你的问题幻灯片的实际数量调整代码。

特别说明，在代码中，Slide4是最后添加的统计答题情况幻灯片的对象名。此外，我使用了一个变量ErrorSlideNo，主要是避免如果未在规定的时间回答或者未在规定的时间回答正确，幻灯片自动跳到下一题时进行错误的答题结果计数。

未完待续……

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

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

vba