VBAで指定秒数毎にサブルーチンを実行したい

Question

実現したいこと

• VBAでして指定秒数毎にサブルーチンを実行したい

発生している問題・エラーメッセージ

コンパイルエラー：
メソッドまたはデーターメンバーが見つかりません。

と表示されて動きません。

ここまでは正常に動きました

Sub CalculateDate()

    Dim numDays As Integer
    Dim currentDate As Date
    
    '38営業日後の日付を表示
    numDays = 38
    currentDate = Date
    For i = 1 To numDays
        currentDate = DateAdd("d", 1, currentDate)
        Do While Weekday(currentDate, vbMonday) > 5 Or IsHoliday(currentDate)
            currentDate = DateAdd("d", 1, currentDate)
        Loop
    Next i
    ActivePresentation.Slides(1).Shapes("lp_real_m").TextFrame.TextRange.Text = Format(currentDate, "mm")
    ActivePresentation.Slides(1).Shapes("lp_real_d").TextFrame.TextRange.Text = Format(currentDate, "dd")

End Sub

Function IsHoliday(testDate As Date) As Boolean
    ' 国民の祝日のリストを設定する
    Dim holidays As Variant
    holidays = Array("1/1", "1/11", "2/11", "2/23", "3/20", "4/29", "5/3", "5/4", "5/5", "7/18", "8/11", "9/19", "9/23", "11/3", "11/23", "12/23")
    Dim i As Integer
    For i = 0 To UBound(holidays)
        If Format(testDate, "m/d") = holidays(i) Then
            IsHoliday = True
            Exit Function
        End If
    Next i
    IsHoliday = False
End Function

常に最新の日付を表示したいため、
CalculateDateサブルーチンを5秒に1回実行するよう

Sub RunEveryFiveSeconds()
    '5秒毎に実行するサブルーチンの名前を指定
    Application.OnTime Now + TimeValue("00:00:05"), "CalculateDate"
End Sub

というコードを1行目に貼り付けたところ、

コンパイルエラー：
メソッドまたはデーターメンバーが見つかりません。

というエラーになり、「Sub RunEveryFiveSeconds()」と「.OnTime」がハイライトしています。

ご教示いただけると助かります。
何卒よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

PowerPoint

Comments

[sk.exe]

> Application.OnTime Now + TimeValue("00:00:05"), "CalculateDate"

その場合の Application とは（Excel.Application オブジェクトではなく）
PowerPoint.Application オブジェクトです。

> メソッドまたはデーターメンバーが見つかりません。

PowerPoint.Application オブジェクトに OnTime というメソッドはありませんので、
件のエラーが発生します。

[YT0014]

VBAの仕様は、アプリケーション毎に異なりますが、PowerPointに、Application.OnTimeが存在することは確認されているのでしょうか？
こちらでざっと調べた限りでは、ExcelとWordでの存在は確認できましたが、PowerPointでの存在は確認できませんでしたが。

Answer 1

修正依頼にコメントがあるように、PowerPointアプリケーションには OnTime メソッドはないので別の方法を考える必要があります。
Doループで経過時間を計測して、指定時間を超えたら実行するという方法があります。

下記の RunEveryFiveSeconds を実行すると5秒間隔で CalculateDate を実行します。
StopEveryFiveSecondsを実行すると繰り返しを停止します。

Option Explicit
Dim TimerStop As Boolean

Sub RunEveryFiveSeconds()
    Dim NextTime As Date
    TimerStop = False
    Do
        If NextTime <= Now Then
            Call CalculateDate
            NextTime = Now + TimeSerial(0, 0, 5)
        End If
        DoEvents
    Loop Until TimerStop
End Sub

Sub StopRunEveryFiveSeconds()
    TimerStop = True
End Sub

Comments

[HYBCJ]

ありがとうございます！解決しました