大分前に書いた記事について問い合わせがありましたので、マクロを作成しなおすことにしました。
カウントダウンタイマーを作成する、PowerPointマクロです。
(仕組みは上記記事の通り、アニメーションの開始タイミングを利用しています。)
VBAコード
Option Explicit Public Sub btnTimer_onAction(control As IRibbonControl) Dim iSec As Variant Dim iStep As Variant iSec = VBA.InputBox(Prompt:="秒数を指定してください。", Default:=120) If iSec = "" Or Not IsNumeric(iSec) Then Exit Sub iSec = CInt(StrConv(iSec, vbNarrow)) iStep = VBA.InputBox(Prompt:="間隔を指定してください。", Default:=1) If iStep = "" Or Not IsNumeric(iStep) Then Exit Sub iStep = CInt(StrConv(iStep, vbNarrow)) CreateCountDownTimer iSec, iStep MsgBox "処理が終了しました。", vbInformation + vbSystemModal End Sub Private Sub CreateCountDownTimer(ByVal TargetSec As Integer, _ Optional ByVal TargetStep As Integer = 1, _ Optional ByVal FontName As String = "Meiryo UI", _ Optional ByVal FontSize As Single = 72) '選択中のスライドにカウントダウンタイマー作成 Dim sld As PowerPoint.SlideRange Dim d As Date Dim i As Long Select Case ActiveWindow.ViewType Case ppViewNormal On Error Resume Next Set sld = ActiveWindow.Selection.SlideRange If Err.Number <> 0 Then MsgBox Err.Description, vbCritical + vbSystemModal Exit Sub End If On Error GoTo 0 For i = TargetSec To 0 Step -TargetStep d = CDate(i \ 3600 & ":" & ((i Mod 3600) \ 60) & ":" & (i Mod 60)) With sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 100, 100) .Fill.Background With .TextFrame2 With .TextRange 'フォント設定 If Len(Trim(FontName)) > 0 Then .Font.Name = FontName If FontSize > 0 Then .Font.Size = FontSize .ParagraphFormat.Alignment = msoAlignCenter .Text = Format(d, "hh:nn:ss") End With .WordWrap = False .AutoSize = msoAutoSizeNone .VerticalAnchor = msoAnchorMiddle End With '図形サイズ・位置調整 .Width = ActivePresentation.PageSetup.SlideWidth .Height = ActivePresentation.PageSetup.SlideHeight .Select With ActiveWindow.Selection.ShapeRange .Align msoAlignMiddles, True .Align msoAlignCenters, True End With With .AnimationSettings If i = TargetSec Then .AdvanceMode = ppAdvanceOnClick Else .AdvanceMode = ppAdvanceOnTime End If .AdvanceTime = TargetStep 'アニメーションが実行されるまでの時間 .EntryEffect = ppEffectAppear End With End With Next End Select End Sub
リボンXML
<?xml version="1.0" encoding="utf-8"?> <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <ribbon> <tabs> <tab idMso="TabInsert"> <group id="grpTimer" label="カウントダウン"> <button id="btnTimer" label="タイマー作成" size="large" imageMso="TimeInsert" onAction="btnTimer_onAction" /> </group> </tab> </tabs> </ribbon> </customUI>
アドイン化したファイル
上記コードをアドイン化したのがこちらのファイルになります。
上記アドインを読み込むと、「挿入」タブに「カウントダウン」グループが作成され、その中に「タイマー作成」ボタンが表示されます。
このボタンを押すとタイマーの秒数と間隔を設定でき、選択中のスライドに自動的にタイマー用のテキストボックスが挿入されます。
(スライドショー実行→クリックすることでタイマー開始です。)
タイマー用テキストボックスのフォントやサイズ、色は下図のようにスライド上のすべてのオブジェクトを選択すれば、一括で変更することができます。
作成したタイマーはスライドごとコピーすれば別のファイルでも使用できるため、なかなか使い勝手は良いだろうと思いますが、タイマーの秒数を長くするほど、間隔を短くするほどテキストボックスの数が増え、ファイルが重くなってしまうので、その点は注意が必要です。
この記事へのコメントはありません。