Excel VBAによるPowerpointへの画像の貼り付け

前提

VBA初心者です。
Excel　VBAのみでPowerpointへの画像の貼り付け等を行いたいです。

実現したいこと

Excel VBAを用いて指定のフォルダ内の複数の画像をPowerPointのスライドに並べたいです。

現在、下記のコードによりフォルダ内の1枚の画像をExcelに貼り付ける　→ ExcelからPowerPointのスライドに画像を貼り付けるということはできましたが、以下2点の方法が分かりません。
①フォルダ内の画像をそのままPowerpointへ貼り付ける
②フォルダ内にある複数の画像をPowerPointへ貼り付ける

どうかご教授お願い致します。

発生している問題・エラーメッセージ

エラーメッセージ


### 該当のソースコード

```VBA
ソースコード
Sub Image02() 
   Dim ws As Worksheet
   Set ws = ThisWorkbook.Worksheets("画像")
    With Sheets("画像").Pictures.Insert("C:\Users\xxxx\Desktop\xxx\xx.jpg")
 
        .Top = Range("B2").Top   
        .Left = Range("B2").Left  
              
        If .Width > Range("B2").Width Then  
                .Width = Range("B2").Width 
        End If
        If .Height > Range("B2").Height Then  
                .Height = Range("B2").Height  
        End If
        
        .Cut 
    End With
    
    With Sheets("画像")
        ws.Range("B2").Select
        .Pictures.Paste 
    End With

'-------------------------------------------------
Dim ppApp As New PowerPoint.Application
    Dim ppPt As Presentation
    Dim ppSlide As Slide
    Dim ppShape As PowerPoint.Shape
    'ppApp.Visible = True
    Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")
  
    'スライド番号1を指定
    Set ppSlide = ppPt.Slides(1)
  
    Set ws = ThisWorkbook.Worksheets("画像")
    'セル範囲を画像で貼りつけ
    ws.Range("B2").CurrentRegion.Copy
    'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。
    ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse
    Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形
    ppShape.Top = Application.CentimetersToPoints(1) '上位置
    ppShape.Left = Application.CentimetersToPoints(1) '左位置
    ppShape.LockAspectRatio = msoTrue '縦横比を固定
    ppShape.Width = Application.CentimetersToPoints(10) '横幅

End Sub

試したこと

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

B2にフォルダー
B6～ファイル名、セット位置
が
記載されたExcelの表からパワポのスライドを作成する

処理イメージが合っているか？自信がないのですが、下記のように作成してみました。
https://www.youtube.com/watch?v=ELYLw9dn5Y4
↑こんな感じでテストしてみました。
コードをアレンジして使ってみてください。

Excelシートのイメージ

ポイント
.Shapes.AddPicture でパワポのスライドに画像ファイル指定で図を挿入できるので、
Excel経由で.Copyしなくても、大丈夫そうです。
Shapes.AddPicture をぐぐってみてください。

ソースコード

Excelの画像ファイルリストから、
パワポのスライドを作成してみます。

VBA
1Sub ExcelからPowerPointへ画像ファイルをセット20220823()
2
3    Dim ppApp As Object   'PowerPoint.Application
4    Set ppApp = CreateObject("PowerPoint.Application")
5    ppApp.Visible = True
6    '新規プレゼンファイルの追加 https://www.youtube.com/watch?v=5ZQMhv0s9qs
7    ppApp.Presentations.Add '新規プレゼンの追加
8    
9    Dim objSlide As Object   'スライドオブジェクト
10    Dim objPicture As Object '図 Picture
11
12    Dim r As Range    'ファイルの表、基準の位置 表の左上 B5
13    Dim p As Integer  'パワポ側Page と Excel表の行カウンタ
14    Dim strFNAME As String  '画像ファイル名
15    
16    Set r = Range("B5")  'セット開始位置 B6からセット
17    p = 1   'スライドのPページ目、兼、画像のP枚目として使用
18
19    While Trim(r.Offset(p, 0) & "") <> "" 'ファイル名が空になるまでループ
20        'パワポのスライドを追加する https://www.youtube.com/watch?v=0oHFihJNTLo
21        'p枚目のスライド追加 レイアウトは12 ppLayoutBlank
22        Set objSlide = ppApp.ActivePresentation.Slides.Add(p, 12)
23        'ActiveWindow.Selection.SlideRange.Layout = 12  '12:ppLayoutBlank
24             
25        '画像ファイル名はB2のフォルダ+ファイル名です b2は\xxxxx\と\で終わってね
26        strFNAME = Trim(Range("B2")) & r.Offset(p, 0) 'ファイル名
27     
28        '画像ファイルを挿入 画像ファイル名を指定してとりあえず0,0に挿入
29        Set objPicture = objSlide.Shapes.AddPicture(strFNAME, False, True, 0, 0)
30    
31        '図 画像 の プロパティをセット ↑上で挿入された画像のプロパティを調整
32        With objPicture
33            .Top = r.Offset(p, 1)    '位置 上
34            .Left = r.Offset(p, 2)   '位置 左
35            .Width = r.Offset(p, 3)  '幅
36            .Height = r.Offset(p, 4) '高さ
37        End With
38    
39        '次のデータ、次のスライドページへ
40        p = p + 1
41    Wend
42    
43    MsgBox "処理終了 パワポを確認してください"
44    'ここまで
45
46End Sub