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