Powerpoint VBA アニメーション設定付箋効果 - インストールレスプログラミング( ´ー`)

正規表現が読みたくてしょうがありませんが，さすがにパワーポイントのVBAから離れすぎているので，ネタを考えました。

そういえば，実務でよく付箋のようなアニメーション効果を使うのですが，けっこう設定が面倒です。

VBAで設定しようとすると，まったく思いつかない。

これは取り組む価値があるな，と思いやってみました。図形をがっつり動かすことしかやっていませんでしたので，アニメーション効果を扱うと新鮮です。

軌跡で動かすものとかも，考えてみれば軌跡を今なら制御できるんじゃないだろうか。。今度ネタにしてみようかな。。

さて，まず付箋のような効果というのが何を意味しているのかということですが，

パワーポイントでは，意図した順番でしか効果を設定できないと思われている場合もありますが，トリガー図形のクリックにより制御する場合があります。

マクロなど使わなくても，それによってかなり自由な表現が可能。わたしが主にやっていることと，完全に逆のことを言っていますが，もともと高性能なソフトウェアです。

各図形をクリックすると，その図形が消えるように設定すると，付箋のように見えるんですね。

そして，ある一つの図形をクリックすることで，消した付箋がもとに戻るように作ると，繰り返し取り組む教材が作れたりします。

このつくりを多用するんですが，けっこうコツが多くて大変な面があります。ですから，一つの方法として，マクロで自動設定することを今回書いてみます。

コードはこちら。標準モジュールです。

Option Explicit

Sub 付箋づくり()

    Dim AcShp As Shape
    Set AcShp = ActiveWindow.Selection.ShapeRange(1)
    Dim TargetSlide As Slide
    Set TargetSlide = ActivePresentation.Slides(AcShp.Parent.SlideIndex)

    TargetSlide.TimeLine.InteractiveSequences.Add
    
    Dim j As Long, s As Shape
    For Each s In TargetSlide.Shapes
        If Not (s Is AcShp) Then
            With TargetSlide.TimeLine.InteractiveSequences(1).AddEffect(s, msoAnimEffectWipe, , msoAnimTriggerOnShapeClick)
                .Exit = msoTrue
                .EffectParameters.Direction = msoAnimDirectionLeft
                .Timing.Duration = 0.1
            End With
        End If
    Next
    Dim flgFirst As Boolean: flgFirst = True
    For Each s In TargetSlide.Shapes
        If Not (s Is AcShp) Then
            With TargetSlide.TimeLine.InteractiveSequences(1).AddTriggerEffect(s, msoAnimEffectAppear, msoAnimTriggerOnShapeClick, AcShp)
                .Timing.Duration = 0.1
                If flgFirst = False Then .Timing.TriggerType = msoAnimTriggerWithPrevious
            End With
            flgFirst = False
        End If
    Next

End Sub