Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

Powerpoint VBA ActiveXコンボボックスでスライド移動するマクロ

さて,ネタを考える,ということを昨晩やってみて一番最初に思いついたものがこれでした。

2013からは,スライドショー中にピンチアウトすればスライドのサムネイル一覧が見れるので,そういう場合は必要ないものかもしれません。

それ以前で動くのか,確認する術が私にはありませんが,いくつかの項目に関するコード例として作成しました。

 ①各スライドのタイトルを取得する方法
 ②コンボボックスのChangeイベントを利用して,スライド移動を実現する方法
 ③VBEへのアクセス例

これらに取り組んでいます。

各スライドにコンボボックスを入れ,それぞれのChangeイベントにコードを書きこむ必要がありましたので,今回はVBEditorを制御しています。
これを可能にするために,次の設定をお願いします。
また,悪意あるVBAコードに対して危険性が増すことになりますので,くれぐれも自己責任でやるかどうかは考えていただくよう,お願いします。

    Powerpoint ファイル→オプション→セキュリティセンター→セキュリティセンターの設定 →
     VBA プロジェクト オブジェクト モデルへのアクセスを信頼する にチェック

この設定により,VBEditorをVBAで制御できるようになります。そして,制御される危険性が増します。


さて,本題。次のコードです。

Option Explicit

Sub test()
    Dim SlideTitle As Variant
    Dim i As Long: i = 1
    ReDim SlideTitle(1 To ActivePresentation.Slides.Count) As String
    Dim TargetSlide As Slide
    
    Dim s As Shape, TitleString As String
    For i = 1 To ActivePresentation.Slides.Count
        Set TargetSlide = ActivePresentation.Slides(i)

        If TargetSlide.Shapes.HasTitle = msoTrue Then
            TitleString = TargetSlide.Shapes.Title.TextFrame.TextRange.Text
            SlideTitle(i) = Format(TargetSlide.SlideNumber, "00") & TitleString
        Else
            SlideTitle(i) = Format(TargetSlide.SlideNumber, "00")
        End If
    Next
    
    Dim X As Long, Y As Long
    X = ActivePresentation.SlideMaster.Width - 100
    Y = ActivePresentation.SlideMaster.Height - 20
    Dim Cmb As Object
    For Each TargetSlide In ActivePresentation.Slides
        On Error Resume Next: TargetSlide.Shapes("SlideSelector").Delete: On Error GoTo 0
        
        With TargetSlide.Shapes.AddOLEObject(X, Y, 100, 20, ClassName:="Forms.ComboBox.1")
            .Name = "SlideSelector"
        End With
        Set Cmb = TargetSlide.Shapes("SlideSelector").OLEFormat.Object
        Cmb.List = SlideTitle
        Cmb.ListIndex = TargetSlide.SlideIndex - 1
    Next
    
    Dim code As Object
    For Each TargetSlide In ActivePresentation.Slides
        Set code = ActivePresentation.VBProject.VBComponents(TargetSlide.Name).CodeModule

        On Error Resume Next
            code.DeleteLines _
                code.ProcStartLine("SlideSelector_Change", 0), _
                code.ProcCountLines("SlideSelector_Change", 0)
        On Error GoTo 0
        code.AddFromString "Private Sub SlideSelector_Change()" & vbNewLine & vbTab & _
            "If SlideShowWindows.Count <> 0 Then" & vbNewLine & vbTab & vbTab & _
            "SlideShowWindows(1).View.GotoSlide SlideSelector.ListIndex + 1" & vbNewLine & vbTab & _
            "End If" & vbNewLine & _
            "End Sub"
    Next
End Sub

いろいろやっている割には短いかもです。

スライドを移動させるわけなので,スライドは数枚用意して,各スライドのタイトルになにか文字を入れておく必要があります。
文字は無いなら無いでもいいですが,移動したかどうかさっぱりなので,入れた方が移動している実感はわきます。

やっている流れとしては,
・全てのスライドのスライド番号とタイトルを取得し,SlideTitleという配列に入れる。
・各スライドにコンボボックスを挿入し,リスト項目を設定。今回はできました。
・各スライドのコンボボックスのコードを書くスライドのクラスモジュールに書き込んでいます。

test を実行すると,
各スライドの右下にスライドを選ぶコンボボックスが作られています。
スライドショーを実行して動くさまを見ていただける・・はず。

ActiveXを挿入して,そのモジュールまで書くという操作は応用が利く話だと思うので,面白かった。

皆様もこのあたりで遊ばれるときは,こまめな保存と履歴を何回かにわけつつひどいダメージを受けないようにご注意をお願いします。
たまにひどい目にあいますから・・(;´▽`A``