
「複数の画像をパワポに貼り付けんのめんどくせえ」
そんな悩みがあると思います。
どーもTakeです。
今回は「画像フォルダにある複数の画像をパワポスライドに順に貼り付けるマクロ」についてご紹介します。
具体的なやり方として PowerPoint マクロを使ってボタン一つで画像をスライドに貼り付けます。
参考までに今回つかったマクロについてもダウンロードできるようにしておきましたので、よければどうぞ!
実行手順
めちゃくちゃ簡単です。
手順
- 画像フォルダを準備
- PowerPointマクロを作成
- PowerPointマクロを実行
画像フォルダを準備
まずは画像フォルダを準備します。
フォルダの名前はなんでもいいですが、画像のファイル拡張子は「jpg、jpeg、 png」です。

PowerPointマクロを作成
開発タブ→VisualBasic からエディタを開き下記ソースコードを貼り付けます。

ソースコード
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | Option Explicit '=============================================== ' 一枚のスライドに一枚の画像を貼る '=============================================== Sub 一枚のスライドに一枚の画像を貼る()     Dim prs As PowerPoint.Presentation     Dim sld As PowerPoint.Slide     Dim shp As PowerPoint.Shape     Dim tmp As PowerPoint.PpViewType     Dim fol As Object, f As Object     Dim fol_path As String     Dim titleMsg     Dim mainTitle     Set prs = ActivePresentation     Set fol = CreateObject("Shell.Application") _     .BrowseForFolder(0, "画像フォルダ選択", &H10, 0)     If fol Is Nothing Then GoTo Fin     fol_path = fol.Self.Path     If SlideShowWindows.Count > 0 Then prs.SlideShowWindow.View.Exit     With ActiveWindow         tmp = .ViewType         .ViewType = ppViewSlide     End With      'フォルダ内のファイル処理     With CreateObject("Scripting.FileSystemObject")         If Not .FolderExists(fol_path) Then GoTo Fin         For Each f In .GetFolder(fol_path).Files             'JPEGファイルのみ処理             Select Case LCase(.GetExtensionName(f.Path))                 Case "jpg", "jpeg", "png"                     Set sld = prs.Slides.Add(prs.Slides.Count + 1, ppLayoutBlank)                     sld.Select                     ' 画像追加                     Set shp = sld.Shapes.AddPicture(FileName:=f.Path, _                                                     LinkToFile:=False, _                                                     SaveWithDocument:=True, _                                                     Left:=0, _                                                     Top:=0)                     '画像リサイズ                     With shp                         .LockAspectRatio = True                         .Width = prs.PageSetup.SlideWidth                         .Height = prs.PageSetup.SlideHeight                         .Select                     End With                 '画像をスライド中央に配置                 With ActiveWindow.Selection.ShapeRange                     .Align msoAlignCenters, True                     .Align msoAlignBottoms, True                 End With             End Select         Next     End With Fin:      ActiveWindow.ViewType = tmp End Sub | 
処理について
ここはプログラミングの処理内容について簡単に説明します(不要な方は割愛して問題ありません)。
- 画像フォルダのフォルダパスを取得
- フォルダパス内にある「jpg、jpeg、 png」をループ文で取得
- ループ処理で「白紙」スライドを一つずつ新規作成し、スライドの大きさに合わせて添付
- 上記の(1)~(3)を画像ファイルの数だけループ
これだけです。めちゃくちゃ簡単だと思います。
ただ苦労した点はスライドの種類の選択です。
もしスライドにタイトルをつけたい場合は、「ppLayoutBlank」という値を任意のものに変更する必要があります。
また画像サイズを変更したい場合は下記のように画像の幅、高さ(Width、Height)に倍率をかけると実現できます。
(下記は画像を半分のサイズにしたい場合、つまり 0.5 倍したい場合の例)
| 1 2 3 4 5 6 7 | '画像リサイズ With shp .LockAspectRatio = True .Width = prs.PageSetup.SlideWidth * 0.5 .Height = prs.PageSetup.SlideHeight * 0.5 .Select End With | 
PowerPointマクロを実行
下記の手順で実行すればOKです!
- 「表示」タブ→「マクロ」→「一枚のスライドに一枚の画像を貼る」を押下
- ダイアログが表示されるので、画像が配架されているフォルダを選択
- スライドに自動で画像が挿入されます!
最後に
いかがでしたでしょうか?
手動で画像を貼りつけるのがめんどくさすぎて、今回作成しました。
また便利なものがあれば作ります。
ではでは。



 
                         
                         
                         
                         
                         
                         
                         
                         
                 
                                       
                                       
                                       
                                       
                                       
                                      