大量の画像ファイルを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ファイルを、一括でスライドに挿入します。



















この記事へのコメントはありません。