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関連

    [Office 365 Solo]Skypeってスマートフォンからも使えるの?

    「Office 365 Soloをインストールしみてました。」でも書い…

  2. Office関連

    [Office 2013]オンライン テンプレートを無効にする。

    前回の記事ではOffice 2013でSkyDriveを無効にする方法…

  3. Office関連

    Word 2013のアクセス キー一覧

    2013/10/24 追記:下記一覧表をPDFファイルにしました。…

  4. Office関連

    Office製品のフィードバックって本当に反映されるの?

    今年の1月に、WordやExcel等のOffice製品で、UI上の不具…

  5. アイコン一覧

    Office 365アイコン(imageMso)一覧(G)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  6. Office関連

    オデッセイ コミュニケーションズ主催のExcel VBA入門セミナーに参加しました。

    今月19日に開催されたオデッセイ コミュニケーションズさん主催の「Ex…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP