インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

Powerpoint VBA 付箋② マクロで全部作る。

以前作った 付箋ぽいやつの 違うバージョンです。
chemiphys.hateblo.jp

トリガー図形と付箋を事前に準備しないとできないように,前回は作られていました。

アニメーション効果等を取り扱うのが初めてだったので,それで手一杯だったのもありますが,手動でやるのが面倒だという部分をさらに作り込んでみることにしました。

準備無しで付箋もトリガー図形も作るバージョンです。


コードはこちら

Option Explicit

Sub 付箋づくり2()

    Dim TargetSlide As Slide
    Set TargetSlide = ActiveWindow.View.Slide

    Dim ret As Variant
    ret = InputBox("付箋の数,高さ(px),元に戻すマークを,区切りで答えてください。" & vbLf & "マーク  1:スマイル 2:稲妻 3:太陽", , "10,45,1")
    If InStr(ret, ",") = 0 Then Exit Sub
    Dim 付箋の数 As Long, 付箋の高さ As Long, マーク種類 As Long, MarkShp As Long
    付箋の数 = Split(ret, ",")(0)
    付箋の高さ = Split(ret, ",")(1)
    マーク種類 = Split(ret, ",")(2)
    
    MarkShp = Switch(マーク種類 = 1, msoShapeSmileyFace, マーク種類 = 2, msoShapeLightningBolt, マーク種類 = 3, msoShapeSun)
    If MarkShp = 0 Then MarkShp = msoShapeSmileyFace
    
    Dim StartX As Long: StartX = ActivePresentation.SlideMaster.Width + 10
    
    Dim TriggerShp As Shape: Set TriggerShp = TargetSlide.Shapes.AddShape(MarkShp, StartX, 0, 45, 45)
    TriggerShp.Fill.ForeColor.RGB = vbYellow
    TriggerShp.Name = "元に戻す"
    
    TargetSlide.TimeLine.InteractiveSequences.Add
    
    Dim 付箋() As Shape: ReDim 付箋(付箋の数)
    Dim i As Long
    
    For i = 1 To 付箋の数
        Set 付箋(i) = TargetSlide.Shapes.AddShape(msoShapeFoldedCorner, StartX + i * 2, 80 + 付箋の高さ * 0.7 * i, 100, 付箋の高さ)
        付箋(i).Name = "付箋" & i
        付箋(i).Fill.ForeColor.RGB = vbYellow
        With TargetSlide.TimeLine.InteractiveSequences(1).AddEffect(付箋(i), msoAnimEffectWipe, , msoAnimTriggerOnShapeClick)
            .Exit = msoTrue
            .EffectParameters.Direction = msoAnimDirectionLeft
            .Timing.Duration = 0.1
        End With
    Next
    
    Dim flgFirst As Boolean: flgFirst = True
    For i = 1 To 付箋の数
        With TargetSlide.TimeLine.InteractiveSequences(1).AddTriggerEffect(付箋(i), msoAnimEffectAppear, msoAnimTriggerOnShapeClick, TriggerShp)
            If flgFirst = False Then .Timing.TriggerType = msoAnimTriggerWithPrevious
            .Timing.Duration = 0.1
        End With
        flgFirst = False
    Next

End Sub

コードの大本は変わっていません。図形を書く部分が追加されただけです。

あと,付箋やトリガー図形は スライド外にまとめて作ります。不要ならすぐ削除できるよう選びやすい場所という判断です。
自分はそこにいっぱい物を置いているんだよ(私自身のことです)という方はSlideMasterからスライド幅や高さを取得して,自分が使いやすい場所に付箋等を作るよう,修正すると使いやすいと思います。

使う様子です。
f:id:chemiphys:20170305092811g:plain
不要な分は外側に残しておけば邪魔はしないので,多めに作って使う分だけスライドの表示域に入れればいい感じだと思います。

他のアニメーション効果との兼ね合いを把握できる能力は私には今のところないので,アニメーションをがっつり設定する前に使っていただければ。。