大分前に書いた記事について問い合わせがありましたので、マクロを作成しなおすことにしました。
カウントダウンタイマーを作成する、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>
アドイン化したファイル
上記コードをアドイン化したのがこちらのファイルになります。
上記アドインを読み込むと、「挿入」タブに「カウントダウン」グループが作成され、その中に「タイマー作成」ボタンが表示されます。

このボタンを押すとタイマーの秒数と間隔を設定でき、選択中のスライドに自動的にタイマー用のテキストボックスが挿入されます。
(スライドショー実行→クリックすることでタイマー開始です。)


タイマー用テキストボックスのフォントやサイズ、色は下図のようにスライド上のすべてのオブジェクトを選択すれば、一括で変更することができます。

作成したタイマーはスライドごとコピーすれば別のファイルでも使用できるため、なかなか使い勝手は良いだろうと思いますが、タイマーの秒数を長くするほど、間隔を短くするほどテキストボックスの数が増え、ファイルが重くなってしまうので、その点は注意が必要です。




















この記事へのコメントはありません。