パワポのVBA「重なりの抽出」ができない

Question

実現したいこと

二つの重なった図形があり（一つは写真、一つは図形）、図形の大きさに写真を切り抜き、フォルダ内の写真を順番に入れ替えて、切り取った結果を保管していく、ということが実現したいです。
写真は定点観測されたもので、必要なところだけを保管し直したいので、写真だけ連続で変わっていく、ということをしています。

発生している問題・分からないこと

「画像を2つとも選択」までは成功しており、「重なりの抽出」の最後の行で「型が一致しない」と出て止まります。ChatGPT先生に聞いても解決しません。

    ' 画像を2つとも選択
    pptShapeNew.Select
    imageFrameCopy.Select msoFalse


    ' 重なりを抽出
    Dim shpRange As Object
    Set shpRange = ActiveWindow.Selection.ShapeRange
    shpRange.MergeShapes msoMergeIntersect

---

エラーメッセージ

実行時エラー　'13':
型が一致しません。

該当のソースコード

shpRange.MergeShapes msoMergeIntersect

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

パワポのVBAなので、ネット検索でもほとんどヒットせず、ChatGPT先生も代替案をくれませんでした。

補足

どなたがお詳しい方、なにとぞどうぞよろしくお願いいたします。

Answer 1

ShapeRangeはプロパティで値の取得のみ可能です。
以下の様にしてみて下さい。

   ActiveWindow.Selection.ShapeRange.MergeShapes msoMergeIntersect

若しくは

   With ActiveWindow.Selection.ShapeRange
      .MergeShapes msoMergeIntersect
   End With

Comments

[miiiiiiiisuke]

回答ありがとうございます。試したところ解決しました！
ベストアンサーに選ばせていただきました。
とても助かりました。本当にありがとうございました。

[sazi]

ShapeRangeの処理を複数行うなら、withを使うと良いかと思います。

Answer 2

二つの重なった図形があり（一つは写真、一つは図形）、図形の大きさに写真を切り抜き

Sub MergePictureAndOval()
    
    Dim sldTarget As PowerPoint.Slide
    
    'アクティブなスライドを参照
    Set sldTarget = ActiveWindow.Selection.SlideRange(1)
    
    Dim strPictureFilePath As String
    
    '図の絶対パスの指定
    strPictureFilePath = "C:\FolderName\FileName.jpg"
    
    Dim shpPicture As PowerPoint.Shape
    Dim shpOval As PowerPoint.Shape
    
    '図の挿入
    Set shpPicture = sldTarget.Shapes.AddPicture2(FileName:=strPictureFilePath, _
                                                  LinkToFile:=msoFalse, _
                                                  SaveWithDocument:=msoTrue, _
                                                  Left:=0, _
                                                  Top:=0, _
                                                  compress:=msoPictureCompressDocDefault)
    '楕円の挿入
    Set shpOval = sldTarget.Shapes.AddShape(Type:=msoShapeOval, _
                                            Left:=0, _
                                            Top:=0, _
                                            Width:=shpPicture.Height, _
                                            Height:=shpPicture.Height)
    
    Dim shprngMerge As PowerPoint.ShapeRange
    
    '図形範囲の参照
    Set shprngMerge = sldTarget.Shapes.Range(Array(shpPicture.Name, shpOval.Name))
    
    '図形範囲の操作
    With shprngMerge
        '横位置をスライドの左右中央に寄せる
        .Align msoAlignCenters, msoTrue
        '縦位置をスライドの上下中央に寄せる
        .Align msoAlignMiddles, msoTrue
        '図をプライマリ選択範囲として重なり抽出
        .MergeShapes MergeCmd:=msoMergeIntersect, _
                     PrimaryShape:=shpPicture
    End With

    Set shpPicture = Nothing
    Set shpOval = Nothing
    Set shprngMerge = Nothing

End Sub