我有一套 PPT 幻灯片（2 张幻灯片），保存为 PPTM 文件，用作倒计时器，其中剩余时间由幻灯片 2 上的 VBA 控制。
当我在运行 MS Access 365/2019 的 Windows 10 上时，它曾经正常工作。
现在我已经使用 MS 365 Access 迁移到 Windows 11。如果我转到开发人员选项卡上的“运行宏”并选择子项，代码就会运行。如果我进入幻灯片放映，倒计时功能只会播放由语音库.SpVoice但不会更新屏幕内容。
Option Explicit
Const TimerAudioFolder As String = "\\bc.baruch.cuny.edu\shares\ConflictExam\Timer_Audio\"
Const TimerSlideNumber As Integer = 2
Public Sub BAR01_Countdown()
Dim CountTimeEnd As Date
Dim myHours As Integer
Dim myMinutes As Integer
Dim mySeconds As Integer
Dim dispH As Integer
Dim dispM As Integer
Dim dispS As Integer
Dim dispTime As String
Dim secondsRemain As Integer
Dim sTalk As SpeechLib.SpVoice
Set sTalk = New SpeechLib.SpVoice
Dim bGave_90M_Warning As Boolean
bGave_90M_Warning = False
Dim bGave_60M_Warning As Boolean
bGave_60M_Warning = False
Dim bGave_30M_Warning As Boolean
bGave_30M_Warning = False
Dim bGave_15M_Warning As Boolean
bGave_15M_Warning = False
Dim bGave_10M_Warning As Boolean
bGave_10M_Warning = False
Dim bGave_05M_Warning As Boolean
bGave_05M_Warning = False
Dim bGave_01M_Warning As Boolean
bGave_01M_Warning = False
Dim bGave_00M_Warning As Boolean
bGave_00M_Warning = False
Dim countTimeStart As Date
Dim timePassed As Integer
Dim timePassedH As Integer
Dim timePassedM As Integer
Dim timePassedS As Integer
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Header").TextFrame.TextRange.Font.Color.RGB = RGB(9, 60, 113)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Header").Fill.BackColor.RGB = RGB(254, 136, 7)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Info").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Info").Fill.BackColor.RGB = RGB(9, 60, 113)
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "-- WAIT --"
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Please Wait. " & Now
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = "-- WAIT -- --"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 60
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Start " & Now
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = " ----- " & Now
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Font.Color.RGB = RGB(191, 191, 191)
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = Format(Now, "HH:MM AM/PM")
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
DoEvents
CountTimeEnd = Now()
myHours = 0
myMinutes = 3
mySeconds = 0
CountTimeEnd = DateAdd("h", myHours, CountTimeEnd)
CountTimeEnd = DateAdd("n", myMinutes, CountTimeEnd)
CountTimeEnd = DateAdd("s", mySeconds, CountTimeEnd)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
countTimeStart = Now()
sTalk.Speak "The Time is Now " & Format(Now, "HH:MM AM/PM"), SVSFDefault
sTalk.Speak "The session will end at " & Format(CountTimeEnd, "HH:MM AM/PM"), SVSFDefault
sTalk.Speak "Your Time Starts Now. Good Luck.", SVSFlagsAsync
Do Until CountTimeEnd < Now()
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = Format(Now, "HH:MM.SS AM/PM")
secondsRemain = (DateDiff("s", Now, CountTimeEnd))
timePassed = DateDiff("s", countTimeStart, Now)
dispH = Int(secondsRemain / (60 * 60))
dispM = Int(secondsRemain / 60) Mod 60
dispS = secondsRemain Mod 60
timePassedH = Int(timePassed / (60 * 60))
timePassedM = Int(timePassed / 60) Mod 60
timePassedS = secondsRemain Mod 60
If dispH > 0 Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
dispTime = Format(dispH, "00") & ":" & Format(dispM, "00") & "." & Format(dispS, "00")
ElseIf dispM > 0 Then
If dispM >= 10 Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
ElseIf dispM >= 5 Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(227, 108, 9)
Else
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(243, 60, 4)
End If
dispTime = Format(dispM, "00") & ":" & Format(dispS, "00")
Else
If dispS Mod 2 = 0 Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(218, 31, 5)
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Font.Color.RGB = RGB(253, 228, 42)
Else
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(161, 1, 0)
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 202, 42)
End If
dispTime = Format(dispS, "00")
End If
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = dispTime
If dispH > 0 Or dispM > 0 Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Time Remaining"
Else
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Time Remaining (Seconds)" & vbNewLine & _
"Please ensure all answers are on your answer document." & vbNewLine & "No additional time will be provided to transfer your answers."
End If
DoEvents
Debug.Print DateDiff("n", Now, countTimeStart)
If dispH = 1 And dispM = 30 And dispS = 0 Then
If bGave_90M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You have one hour and thirty minutes remaining.", SVSFlagsAsync
End If
bGave_90M_Warning = True
End If
If dispH = 1 And dispM = 0 And dispS = 0 Then
If bGave_60M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You have one hour remaining.", SVSFlagsAsync
End If
bGave_60M_Warning = True
End If
If dispH = 0 And dispM = 30 And dispS = 0 Then
If bGave_30M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You have thirty minutes remaining.", SVSFlagsAsync
End If
bGave_30M_Warning = True
End If
If dispH = 0 And dispM = 15 And dispS = 0 Then
If bGave_15M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You now have fifteen minutes remaining.", SVSFlagsAsync
End If
bGave_15M_Warning = True
End If
If dispH = 0 And dispM = 10 And dispS = 0 Then
If bGave_10M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You now have ten minutes remaining.", SVSFlagsAsync
End If
bGave_10M_Warning = True
End If
If dispH = 0 And dispM = 5 And dispS = 0 Then
If bGave_05M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You now have only five minutes remaining. Please ensure all answers are on your answer document.", SVSFlagsAsync
End If
bGave_05M_Warning = True
End If
If dispH = 0 And dispM = 1 And dispS = 0 Then
If bGave_01M_Warning = False Then
If timePassedH > 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hours and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH > 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hours have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM > 0 Then
sTalk.Speak timePassedH & " hour and " & timePassedM & "minutes have elapsed", SVSFlagsAsync
ElseIf timePassedH = 1 And timePassedM = 0 Then
sTalk.Speak timePassedH & " hour has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM = 1 Then
sTalk.Speak timePassedM & " minute has elapsed", SVSFlagsAsync
ElseIf timePassedH = 0 And timePassedM > 1 Then
sTalk.Speak timePassedM & " minutes have elapsed", SVSFlagsAsync
Else
'say nothing
End If
sTalk.Speak "You now have one minute remaining. Please ensure all answers are on your answer document.", SVSFlagsAsync
End If
bGave_01M_Warning = True
End If
DoEvents
Loop
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = Format(Now, "HH:MM AM/PM")
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_HEADER").TextFrame.TextRange.Font.Color.RGB = RGB(222, 245, 250)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Header").Fill.BackColor.RGB = RGB(192, 0, 0)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Info").TextFrame.TextRange.Font.Color.RGB = RGB(242, 242, 255)
ActivePresentation.Slides(TimerSlideNumber).Shapes("Rect_CO_Header").Fill.BackColor.RGB = RGB(228, 0, 70)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Stop Working"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Please put your pens and pencils down. Please return all examination materials, including scrap paper and reference sheets, to the examination envelope. Please bring the envelope up to the proctors. Thank you."
DoEvents
sTalk.Speak "Your Time is up", SVSFDefault
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 72
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Pencils/Pens Down"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
sTalk.Speak "Please put your pens and pencils down. "
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 72
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Return Exam"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
sTalk.Speak "Please return all examination materials, including scrap paper and reference sheets, to the examination envelope. "
DoEvents
sTalk.Speak "Please bring the envelope up to the proctors.", SVSFlagsAsync
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Stop Working"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Please return all examination materials, including scrap paper and reference sheets, to the examination envelope. Please bring the envelope up to the proctors. Thank you."
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Thank You."
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
sTalk.Speak "Thank you for taking your examination with us. "
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 72
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Get Home Safely."
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 22, 60)
DoEvents
Select Case Time()
Case #12:00:01 AM# To #11:59:00 AM#
sTalk.Speak "Have a good day and get home safely."
Case #12:00:00 PM# To #4:59:00 PM#
sTalk.Speak "Have a good afternoon and get home safely."
Case #4:59:01 PM# To #8:00:00 PM#
sTalk.Speak "Have a good evening and get home safely."
Case Else
sTalk.Speak "Have a good night and get home safely."
End Select
DoEvents
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Time Is Up"
DoEvents
BAR01_ContinueCurrentTime 600 'Continue Live Clock for 10 minutes
End Sub
Sub OnSlideShowPageChange()
Debug.Print SlideShowWindows(1).View.Slide.SlideIndex
If SlideShowWindows(1).View.Slide.SlideIndex = TimerSlideNumber Then
BAR01_Countdown
End If
End Sub
Private Sub BAR01_ContinueCurrentTime(lLengthInSeconds As Long)
Dim bDis As Boolean
bDis = True
Dim CT_CountTimeEnd As Date
CT_CountTimeEnd = Now()
CT_CountTimeEnd = DateAdd("s", CInt(lLengthInSeconds), CT_CountTimeEnd)
Do Until CT_CountTimeEnd < Now()
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = Format(Now, "HH:MM.SS AM/PM")
If (Second(Now) >= 0 And Second(Now) < 4) Or (Second(Now) >= 10 And Second(Now) < 14) _
Or (Second(Now) >= 20 And Second(Now) < 24) Or (Second(Now) >= 30 And Second(Now) < 34) Or _
(Second(Now) >= 40 And Second(Now) < 44) Or (Second(Now) >= 50 And Second(Now) < 54) Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Time Is Up"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(255, 0, 0)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ElseIf (Second(Now) >= 4 And Second(Now) < 7) Or (Second(Now) >= 14 And Second(Now) < 17) _
Or (Second(Now) >= 24 And Second(Now) < 27) Or (Second(Now) >= 34 And Second(Now) < 37) Or _
(Second(Now) >= 44 And Second(Now) < 47) Or (Second(Now) >= 54 And Second(Now) < 57) Then
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 72
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Return Packet To Front"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(227, 108, 9)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
Else
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Stop Working"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(161, 1, 0)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
End If
DoEvents
Loop
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Font.Color.RGB = RGB(255, 0, 0)
ActivePresentation.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = "- FINISHED -"
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
DoEvents
End Sub
Private Sub App_PresentationOpen(ByVal Pres As Presentation)
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Don't Start. "
Pres.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Please Wait. " & Now
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = "-- WAIT -- --"
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
Pres.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Font.Color.RGB = RGB(191, 191, 191)
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = Format(Now, "HH:MM.SS AM/PM")
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").Fill.BackColor.RGB = RGB(255, 255, 255)
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
End Sub
Private Sub App_SlideShowEnd(ByVal Pres As Presentation)
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Size = 138
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeHeading").TextFrame.TextRange.Text = "The Current Time Is:"
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Font.Color.RGB = RGB(191, 191, 191)
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Text = "-- -WAIT- -- "
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Font.Color.RGB = RGB(0, 75, 141)
Pres.Slides(TimerSlideNumber).Shapes("MainTitle").TextFrame.TextRange.Text = "Please Wait. The time is: " & Now
Pres.Slides(TimerSlideNumber).Shapes("SubTitle").TextFrame.TextRange.Text = "Please Wait. " & Now
Pres.Slides(TimerSlideNumber).Shapes("CurrentTimeTimeString").TextFrame.TextRange.Font.Color.RGB = RGB(191, 191, 191)
End Sub
答案1
我认为你需要制作一个更简单但可重现的示例。当你甚至没有指出一两行代码没有按你期望的方式工作时，人们会费力地浏览你的代码，这太过分了。话虽如此，你可能只是遇到了 PPT 的一个怪癖。在对屏幕上的内容进行更改后，尝试使用
ActiveWindow.View.GoToSlide(x)
其中 x 是您更改的幻灯片的索引。如果这不起作用，请尝试添加幻灯片外的形状，然后在 GoToSlide 代码之前将其删除。这有时会强制刷新。