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

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

パワーポイントの図形のインデックスについて②

chemiphys.hateblo.jp
つづきです。

ほとんど時間がなかったのですが,不要な部分をそぎ落として,あと,imihitoさんがコメントにくださったコードの最初の部分がとてもかっこよく,

そこを真似させてもらってとりあえず,短めの関数にしました。

【追記】imihitoさんのDictionaryを使うとシンプルに書けるというアドバイスを受けて書きなおしました。

Function SIndex(ByVal TargetShape As PowerPoint.Shape) As Long
    Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(TargetShape.Parent.SlideIndex)
    
    If TargetShape.Child = msoTrue Then '完全に真似させてもらった。グループ内図形の場合は親を返す
        Let SIndex = SIndex(TargetShape.ParentGroup)
        Exit Function
    End If
    
    Dim db As Object: Set db = CreateObject("Scripting.Dictionary")
    Dim s As Shape
    Dim i As Long: i = 1
    
    For Each s In TargetSlide.Shapes
        db(s.Id) = i
        i = i + 1
    Next
    
    Let SIndex = db.Item(TargetShape.Id)
    
End Function

こっちがカッコイイ。ループでごりごり解決するんじゃなくて,m9(゚∀゚)ビシッとSindexを決めています。

↓これは古いコードです。

Function SIndex(ByVal TargetShape As PowerPoint.Shape) As Long
    Dim TargetSlide As Slide: Set TargetSlide = ActivePresentation.Slides(TargetShape.Parent.SlideIndex)
    
    If TargetShape.Child = msoTrue Then  '完全に真似させてもらった。グループ内図形の場合は親を返す
        Let SIndex = SIndex(TargetShape.ParentGroup)
        Exit Function
    End If
    
    Dim ShapeID(): ReDim ShapeID(1 To TargetSlide.Shapes.Count)
    Dim s As Shape
    Dim i As Long: i = 1
    
    For Each s In TargetSlide.Shapes
        ShapeID(i) = s.Id
        i = i + 1
    Next
    
    For i = 1 To TargetSlide.Shapes.Count
        If TargetShape.Id = ShapeID(i) Then
            Let SIndex = i
            Exit Function
        End If
    Next
End Function

↑一か所,imihitoさんのコードのままの"ShapeIndex"という記述が残ってたので,修正しました。

ターゲットがグループの子だったら,親に対して再度この関数を適用する,という部分があまりにもかっこいい。

冒頭の記事のコメント部分にimihitoさんのコードがあります。

全く違うアプローチで同じ機能を目指しているのがとても興味深い関数づくりとなりました。

Letも普段は省略されているんですね。Functionに値を返す時を明示的に書くと,あとで読み返しやすいので,Letも真似しています。

ほんと,他の方のコードを見させてもらうといろいろ勉強になります

これもタノシカッタ。