PowerPointでプレゼンタイマーを装備する

PowerPointは、商品のプレゼンだけでなく、様々な研修会などでも利用されています。また、自分の場合、デジタルサイネージの土台としても使っており、さらにはウェブページのパーツを作るときにもPowerPointの恩恵を得られます。さて、そんなPowerPointですが、研修時に別にタイマーアプリが必要であったり、プレゼンの流れで見せたいときに、普通のWindowsのアプリですと、余計な機能や見てくれが派手などで使い勝手の良いタイマーがなかなかありません（勝手にアプリ入れられないというセキュリティ上の制限もあったり）

ということで、作ったのがVBAだけで作成したPowerPoint上で使えるタイマーです。既存のPowerPointにも組み込めますが、その場合Shapeの名前が異なるのでそこだけは修正が必要です。

図：シンプルで既存のプレゼンファイルにも組み込めます。

1 今回使用するファイル
2 ソースコード
3 関連リンク

今回使用するファイル

プレゼンテーションタイマー PowerPointファイル

ソースコード

リボンのXMLコード

今回のプレゼンタイマーは、PowerPointファイルにVBAを仕込んで、そのコマンドをリボンから実行できるようにしています。タイマーを実行すると、プレゼンも開始されるようになっています。ただし、タイマーはストップを押さない限り、プレゼン解除しても走り続けます。リボンは、Custom UI Ribbon Editorを使って、書いています。

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="OnLoad">
  <ribbon>
    <tabs>
      <tab id="macroman" label="Timer" getVisible="Tab_getVisible">
        <group id="grpTimer" label="カウントダウン">
          <button id="btnTimer" label="タイマー作成" size="large" imageMso="TimeInsert" onAction="btnTimer_onAction" />
          <button id="stoptimer" label="タイマー停止" size="large" image="Snowman-icon" onAction="stop_timer" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

起動時には、Excelなどの時と同じように、onLoadで指定した関数が実行されTimerというタブがアクティブになります。それぞれのボタンにはonActionで指定した関数が紐付けられています。

タイマー開始

'データ取得時刻を格納するグローバル変数
Public timerman As Variant
Public rng As Double '一時停止時間格納用
Public rng_s As Variant

Public Function btnTimer_onAction(control As IRibbonControl)
    '変数の宣言
    Dim result As Variant

    'ストップフラグを初期化（フラグはfalseに戻す）
    stopflag = False

    'タイマー設定
    result = InputBox(Prompt:="タイマー分数を指定してください。", Default:=60)
    If result = "" Then
        'キャンセル処理
        MsgBox "作業はキャンセルされました。"
        Exit Function
    Else
        'グローバル変数にタイマー分数を格納する
        timerman = result
        
        result = MsgBox("タイマーを開始しますか？", vbYesNo + vbDefaultButton2 + vbExclamation)
        If result = vbYes Then
            'スライドショー実行
            Application.ActivePresentation.SlideShowSettings.Run
            
            'カウントダウンタイマー開始
            Call timer_countdown
        Else
            'キャンセル処理
            MsgBox "作業はキャンセルされました。"
            Exit Function
        End If
    End If

End Function

'タイマー実行開始
Public Function timer_countdown()
    'タイマー時刻をセット
    Dim seconds As Variant
    seconds = timerman * 60
    
    'プレゼンが始まったら作業開始
    '変数の宣言
    Dim limit As Date, cnt_d As Double
    
    '指定時刻を秒でセットする
    limit = DateAdd("s", seconds, Time) '現在時刻に指定秒を足す
    
    Do
        '指定時刻 - 現在時刻 (+ 一時停止) を秒で表して60で割ったもの
        cnt_d = (DateDiff("s", Time, limit) + rng) / 60
        
        '分：秒 で表示
        ActivePresentation.Slides(1).Shapes("TextBox 126").TextFrame.TextRange.Text = Int(cnt_d) & ":" & Format(Round((cnt_d - Int(cnt_d)) * 60, 0), "00")
        
        'ゼロになったらDoを抜ける
        If ActivePresentation.Slides(1).Shapes("TextBox 126").TextFrame.TextRange.Text = "0:00" Then
            Exit Do
        End If
        
        'イベントを実行
        DoEvents
        
        '中止判定
        If stopflag Then
            MsgBox "中止しました"
            Exit Function
        End If
    Loop

    MsgBox "終了しましたよ"
    timerman = ""
End Function

タイマー実行開始とともにプレゼンテーションもApplication.ActivePresentation.SlideShowSettings.Runにて自動実行されます。
timer_countdown()では、実行中は常にstopflagを監視し、trueになったらプログラムが停止するようになっています。
指定したタイマー（分）をもとに、Shapesの中の値を書き換えています。0になったらプログラムが停止するようになっています。
PowerPointの場合、作成したテキストボックスなどのShapeはコントロール名がわからないので、以下のコマンドでどういう名前が付けられているかをチェックするとよいでしょう（TextBox 126というのがその名前。これが作成時にしかわからない。）

'現在選択中のシェイプパーツの名前を取得するコマンド
Public Sub getActiveShapeName()
  Dim shp As Shape

  With ActiveWindow.Selection
    If .Type = ppSelectionNone Or _
      .Type = ppSelectionSlides Then Exit Sub

    For Each shp In .ShapeRange
      Debug.Print shp.Name
      Debug.Print shp.Id
      Debug.Print shp.Type
    Next shp

  End With
End Sub

Shapeを選んでからこのコマンドを実行すると、イミディエイトに名前、ID、タイプが表示されます。

タイマーを停止させる場合

タイマーは指定時間内ずっと、VBAが動き続けている状況になります。通常、ExcelなどではCtrl + Breakキーを押すことで、実行中のVBAについて停止が掛けられます。しかしこれはショートカットキーを知らないと使えませんし、スマートじゃありません。そこで今回はフラグを使って、自然にすぐ止まるように組んであげます。

'処理中断フラググローバル変数 True：中止、False：続行
Public stopflag As Boolean

'タイマーストップルーチン
Public Function stop_timer(control As IRibbonControl)
    On Error Resume Next
    'timermanチェック
    If timerman = "" Then
        MsgBox "タイマー設定がありませんよ"
        Exit Function
    End If

    'ストップボタンを押した時刻を取得
    rng_s = Time
    
    'ストップしていた間の秒数を取得して上書き
    rng = rng + DateDiff("s", rng_s, Time)

    'メッセージボックス
    MsgBox ("再開する場合は再度、タイマー作成を実行してください。")
    
    'VBAの実行を一時停止
    Application.DisplayAlerts = ppAlertsNone

    'ストップフラグをtrueに（ここ重要）
    stopflag = True
    
End Function

ポイントは、Endステートメントで強制終了するのではなく、stopflag = trueにし、タイマープログラム側のループをflagを読み取って自然に終了させる点にあります。

Endステートメントの場合

タイマー停止機能に於いて、プロシージャでよくVBAの処理を中止する方法として「Endステートメント」を使う事例がありますが、Microsoft365にて確認してみた所、「セキュリティが・・・」といったエラーメッセージが表示されます。プログラムは停止されますが、このエラーメッセージはApplication.DisplayAlerts = ppAlertsNoneといったコードを追記しても表示されてしまうので、ストップさせる場合には、Endステートメントは避けたほうが良いでしょう。