編集中のスライドに日付テキストボックスを挿入するPowerPointVBA

やあ子供たち。資料作ってるか。今日は今編集中のPowerPointのスライドの右上に、日付現在時刻テキストボックスを入れる便利スクリプトの紹介だよ。ボタンに紐づけてXLMファイルとして持っておけばいつでも使える便利ツールの出来上がりだ。
これはいろいろ調べて2時間くらいで出来たのだけどその中ではいろいろと勉強になった。

  • 現在編集中のスライドを取得するやり方
  • 便利なWith構文
  • WeekDay関数やWeekDayName関数
  • テキストボックスの挿入方法
  • スライドの幅の取得
  • フォント名の指定方法
  • With構文の中でもIf文などが普通に使えてしまうこと
  • 引数付きの関数は、UIから直接呼ぶことは出来ないこと

まそういったノウハウが、以下のコードを詰め込んであるのでよかったら参考にしてくれよな。
(※MS Office2019のみで動作を確認しております。)

Sub PPT_util_DateTag_common(Optional with_time As Integer)
  
    Dim ppApp As New PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    ' 現在編集中のスライドを取得する。
    Set ppPres = ppApp.ActivePresentation
    Dim slide_index
    slide_index = ppApp.ActiveWindow.Selection.SlideRange.SlideIndex
    Set ppSlide = ppApp.ActivePresentation.Slides(slide_index)
    Dim slide_width, box_width
    slide_width = ppPres.PageSetup.SlideWidth
    box_width = 220
    ' 日付ボックスをスライド右上に描画。
    Set shp = ppSlide.Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=slide_width - box_width, Top:=0, Width:=box_width, Height:=21)
    With shp.TextFrame2
        .TextRange.Text = Date & "(" & WeekdayName(Weekday(Date)) & ") "
        If (with_time > 0) Then
            .TextRange.Text = .TextRange.Text & Time
        End If
        .TextRange.Font.Name = "Meiryo UI"
        .TextRange.Font.NameFarEast = "Meiryo UI"
        .TextRange.Font.Size = 12
    End With
    ' 曜日ごとに色を変える
    Select Case Weekday(Date)
        Case 2
            shp.Fill.ForeColor.RGB = RGB(160, 30, 30) '月曜日
        Case 3
            shp.Fill.ForeColor.RGB = RGB(230, 180, 60) '火曜日
        Case 4
            shp.Fill.ForeColor.RGB = RGB(150, 200, 150) '水曜日
        Case 5
            shp.Fill.ForeColor.RGB = RGB(150, 120, 50) '木曜日
        Case 6
            shp.Fill.ForeColor.RGB = RGB(0, 20, 150) '金曜日
        Case Else
            shp.Fill.ForeColor.RGB = vbBlack
    End Select

End Sub

Sub PPT_util_DateTag()
    Call PPT_util_DateTag_common(0)
End Sub

Sub PPT_util_DateTagTime()
    Call PPT_util_DateTag_common(1)
End Sub

実際にどんな感じになるのかは、以下図をご参考下さい。
f:id:nurs:20211014115855p:plain
やーこれねー、どうよこれ。「私ずっとこういうの欲しかったの。」「私、ずっとこういうのが欲しかったんですっ!」って声がたくさん聞こえてきそうじゃないかこれ。おじさんはPowerPointファイルを日記代わりにしていて、テーマごとにあちこちに作ってるんだけど、この日付情報の入力を手動でずっとやってきたんだよね。いつか自動化したいなと思ってさ。
チャオ!