Office関連

カウントダウンタイマーを作成するPowerPointマクロ

大分前に書いた記事について問い合わせがありましたので、マクロを作成しなおすことにしました。

カウントダウンタイマーを作成する、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>

アドイン化したファイル

上記コードをアドイン化したのがこちらのファイルになります。

上記アドインを読み込むと、「挿入」タブに「カウントダウン」グループが作成され、その中に「タイマー作成」ボタンが表示されます。

CreateCountDownTimer_01

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

CreateCountDownTimer_02

CreateCountDownTimer_03

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

CreateCountDownTimer_04

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

Google Sheets API v4が登場しました。前のページ

[Officeアドイン]ダイアログを表示する。次のページ

関連記事

  1. アイコン一覧

    Office 2013 アイコン一覧(S)

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    右クリックから図形の配置 for Office 2013

    HPの掲示板に"右クリックから「配置」を実行できないか?"という質問が…

  3. Office関連

    オデッセイ コミュニケーションズ主催のWord活用無料セミナーに参加しました。

    Club Microsoft会員限定、オデッセイ コミュニケーションズ…

  4. Office関連

    サジェスト機能を利用したWord用ツール

    「Webサービスのサジェスト機能についてまとめてみました。」でWebサ…

  5. Office関連

    Chrome DevTools ProtocolでEdgeを操作するVBAマクロ

    Microsoft Edgeの操作を自動化する際はWebDriverを…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP