PowerPointマクロにて他スライドのトリガーを使用したい。

Question

PowerPointのマクロを利用してプレゼンテーションを作成しています。

・スライド1
★timer
★stopButton
・スライド2
★timer
★stopButton
(★はオブジェクト)

スライド1にタイマーを動かすかつ止めるマクロを実装しています。
スライド2でstopButton時にスライド1とスライド2のtimerが止まるようにしたいのですが、
スライド1のstopButton押下時しかtimerが止まりません。

timerを止めるのはフラグを利用しているのですが、
スライド1内にスライド2のstopButton押下時にフラグをfalseにするといったように
他のスライドをトリガーにすることはできますでしょうか。

Option Explicit

'スタートボタン押下時のTimer()関数の戻り値
Dim sStart As Single
'現在時刻のTimer()関数の戻り値
Dim sCurrent As Single
'前回表示を更新した自国のTimer()関数の戻り値
Dim sPrevious As Single
'True:カウントアップ　false:停止
Dim bCount As Boolean
'時間
Dim iHour As Integer
'分
Dim iMin As Integer
'秒
Dim iSec As Integer
Dim strTmp As String

'スライドショーでページが切り替わった時に実行
Public Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
    'スライドショー一枚目に切り替えたとき0秒を表示
    If ActivePresentation.SlideShowWindow.View.Slide.SlideIndex = 1 Then
        Label1.Caption = strTmp
    End If
End Sub
'スライドショーが終了時に実行
Public Sub OnSlideShowTerminate(ByVal Wn As SlideShowWindow)
    'タイマーの更新を終了
    bCount = False
End Sub
Private Sub StartButton_Click()

    bCount = True

    'sStartに現在の時刻を秒数にしたものを代入
    sStart = Timer()
    
    'Lbel1にsStartを表示
    'CStr 関数は、数値や日付などを文字列型 (String) に変換
    Label1.Caption = "00:00"
    
    '更新時刻を記録
    sPrevious = sStart
    
    'bCountがtrueの間、タイマーを更新。ストップボタンが押されるとbCountがfalseになりタイマーが止まる
    Do While (bCount = True)
        'sCurrentに現在時刻を代入
        sCurrent = Timer()
        
        If (sCurrent - sPrevious) >= 1 Then
        
            '経過秒を表す整数
            Dim iElapsedSec As Integer
            iElapsedSec = CInt(sCurrent - sStart)
            
            iHour = iElapsedSec \ 3600
            iMin = (iElapsedSec Mod 3600) \ 60
            iSec = (iElapsedSec Mod 3600) Mod 60
            
            Dim strHour As String
            Dim strMin As String
            Dim strSec As String
            
            '時間が二桁以外の場合ゼロを足す
            If iHour >= 10 Then
                strHour = CStr(iHour) & ":"
            Else
                strHour = "0" & CStr(iHour) & ":"
            End If
            
            '分が二桁以外の場合ゼロを足す
            If iMin >= 10 Then
                strMin = CStr(iMin) & ":"
            Else
                strMin = "0" & CStr(iMin) & ":"
            End If
            
            '秒が二桁以外の場合ゼロを足す
            If iSec >= 10 Then
                strSec = CStr(iSec)
            Else
                strSec = "0" & CStr(iSec)
            End If
            
            Label1.Caption = strMin & strSec
            Slide154.Label1.Caption = strMin & strSec
            strTmp = strMin & strSec
            sPrevious = sCurrent
        End If
        DoEvents
    Loop
End Sub
Private Sub StopButton_Click()
    bCount = False
End Sub

Answer 1

Option Explicit
Private Sub StartButton_Click()
    bCount = True
    TimeCount
End Sub

Private Sub StopButton_Click()
     bCount = False
End Sub

Option Explicit
Public bCount As Boolean

Sub TimeCount()
    Do While bCount
    Dim sl As Slide, sh As Shape
    For Each sl In ActivePresentation.Slides
        For Each sh In sl.Shapes
            If sh.Name = "Label1" Then sh.OLEFormat.Object.Caption = Now()
    Next sh, sl
    DoEvents
    Loop
End Sub