大量の画像ファイルを1枚/1スライドで挿入する必要があり、
- 白紙のスライドを追加し、画像ファイルを挿入する。
- 画像の大きさをスライドに合わせる。
- 画像をスライドの上下左右中央に配置する。
といった作業をいちいち手作業で行うのは面倒くさかったので、マクロを組むことにしました。
指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ
Option Explicit Public Sub InsertImages() '指定したフォルダ内の画像ファイルを一括挿入 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 Set prs = ActivePresentation 'スライドショー表示になっていたら解除 If SlideShowWindows.Count > 0 Then prs.SlideShowWindow.View.Exit With ActiveWindow tmp = .ViewType 'ウィンドウの表示モード記憶 .ViewType = ppViewSlide End With '画像フォルダ取得 Set fol = CreateObject("Shell.Application") _ .BrowseForFolder(0, "画像フォルダ選択", &H10, 0) If fol Is Nothing Then GoTo Fin fol_path = fol.Self.Path 'フォルダ内のファイル処理 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" 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 '縦横比を固定 '挿入した画像をスライドのサイズに合わせる If .Width > .Height Then .Width = prs.PageSetup.SlideWidth Else .Height = prs.PageSetup.SlideHeight End If .Select End With '画像をスライド中央に配置 With ActiveWindow.Selection.ShapeRange .Align msoAlignCenters, True .Align msoAlignMiddles, True End With End Select Next End With Fin: ActiveWindow.ViewType = tmp 'ウィンドウの表示モードを元に戻す End Sub
上記マクロを実行すると、ダイアログから選択したフォルダ内にあるJPEGファイルを、一括でスライドに挿入します。
この記事へのコメントはありません。