VBScriptに画像ファイルをドラッグAndドロップしてパワポのスライドに図・画像を複数貼り付ける

やりたいこと
パワーポイントのスライドに複数画像ファイルを貼り付ける
操作方法は、作成したVBSに画像ファイルをドロップする

知恵袋
detail.chiebukuro.yahoo.co.jp
の回答・ヒントになるか？自信無いが作成してテスト

#VBScript #PowerPointVBA #パワポ #画像貼り付け #マクロ #デバッグ #Shapes #AddPicture

下記、いつもの解説動画・・・あのあのイライラ動画ですがよろしく・・・
youtu.be
https://youtu.be/jZV4o_Uz0oY
目次
00:00 挨拶、やりたいこと
00:48 いきなりテストしてみる
02:06 挿入図ファイル Shapes.AddPicture
02:33 VBSの処理説明
03:58 プロパティを修正後テスト
06:45 再度コード説明を繰り返す

1.PowerPoint2003でマクロ記録パワポのスライドに図を画像ファイルから追加する

PowerPoint2003でマクロ記録すると、
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="E:\2003マクロ記録\PowerPoint\20220823\挿入図ファイルから.JPG", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=208, Top:=165, Width:=304, Height:=211).Select
で
記録されました。

挿入図ファイルから

Sub Macro1()
'
' マクロ記録日: 2022/8/23 ユーザー名: Ken3
'

    ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:="E:\2003マクロ記録\PowerPoint\20220823\挿入図ファイルから.JPG", LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=208, Top:=165, Width:=304, Height:=211).Select
    ActiveWindow.Selection.Unselect
    ActiveWindow.Selection.SlideRange.Shapes("Picture 5").Select
    With ActiveWindow.Selection.ShapeRange
        .IncrementLeft -166.12
        .IncrementTop -134.62
    End With
    With ActiveWindow.Selection.ShapeRange
        .ScaleWidth 2.05, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 2.05, msoFalse, msoScaleFromTopLeft
    End With
End Sub

2.作成したVBSソースをテストする

記録されたコードを修正してみます。

VBSに投げられた、画像ファイルから、パワポのスライドを作成してみます。

'----  XXXX.vbs で 保存して使ってください
Dim nMAX, n

nMAX = Wscript.Arguments.Count
 
If nMAX = 0 Then  '引数無しの時
  WScript.Echo "引数を受け取れません" & vbCrLf & "終了しますね"
  WScript.Quit '途中終了
End If

Dim ppApp
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True
'新規プレゼンファイルの追加 https://www.youtube.com/watch?v=5ZQMhv0s9qs
ppApp.Presentations.Add '新規プレゼンの追加

Dim objSlide   'スライドオブジェクト
Dim objPicture '図 Picture

For n = 0 to nMAX - 1  '配列は0からなので-1までループ
    'パワポのスライドを追加する https://www.youtube.com/watch?v=0oHFihJNTLo
    'n枚目(n+1)のスライド追加 レイアウトは12 ppLayoutBlank
    Set objSlide = ppApp.ActivePresentation.Slides.Add(n + 1, 12)
    'ActiveWindow.Selection.SlideRange.Layout = 12  '12:ppLayoutBlank
 
    '画像ファイルを挿入 画像ファイル名を指定してとりあえず0,0に挿入
    Set objPicture = objSlide.Shapes.AddPicture(Wscript.Arguments(n), False, True, 0, 0)

    '図 画像 の プロパティをセット ↑上で挿入された画像のプロパティを調整
    With objPicture
        .Top = 100    '位置 上 
        .Left = 0     '位置 左
        .Width = 720  '幅
        .Height = 360 '高さ
    End With

Next

MsgBox "処理終了 パワポを確認してください"
'ここまで