PowerPointでプレゼンタイマーを装備する
PowerPointは、商品のプレゼンだけでなく、様々な研修会などでも利用されています。また、自分の場合、デジタルサイネージの土台としても使っており、さらにはウェブページのパーツを作るときにもPowerPointの恩恵を得られます。さて、そんなPowerPointですが、研修時に別にタイマーアプリが必要であったり、プレゼンの流れで見せたいときに、普通のWindowsのアプリですと、余計な機能や見てくれが派手などで使い勝手の良いタイマーがなかなかありません（勝手にアプリ入れられないというセキュリティ上の制限もあったり）
ということで、作ったのがVBAだけで作成したPowerPoint上で使えるタイマーです。既存のPowerPointにも組み込めますが、その場合Shapeの名前が異なるのでそこだけは修正が必要です。
図：シンプルで既存のプレゼンファイルにも組み込めます。
今回使用するファイル
ソースコード
リボンのXMLコード
今回のプレゼンタイマーは、PowerPointファイルにVBAを仕込んで、そのコマンドをリボンから実行できるようにしています。タイマーを実行すると、プレゼンも開始されるようになっています。ただし、タイマーはストップを押さない限り、プレゼン解除しても走り続けます。リボンは、Custom UI Ribbon Editorを使って、書いています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
<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で指定した関数が紐付けられています。
タイマー開始
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
'データ取得時刻を格納するグローバル変数 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というのがその名前。これが作成時にしかわからない。）
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
'現在選択中のシェイプパーツの名前を取得するコマンド 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について停止が掛けられます。しかしこれはショートカットキーを知らないと使えませんし、スマートじゃありません。そこで今回はフラグを使って、自然にすぐ止まるように組んであげます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
'処理中断フラググローバル変数 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ステートメントは避けたほうが良いでしょう。
図：マクロセキュリティ低でも出てきますよ
