フォルダ内の画像ファイルをまとめてWord内に貼り込む

写真のサムネイルを紙で印刷したい

もはや、プライベートで撮った写真の一覧を紙でわざわざ見たいなんてことはほとんどありませんが、仕事では結構未だにあります。特に証拠写真みたいなものはちゃんと紙で残さなければならないわけです。でもその写真が数枚であれば手作業で挿入を繰り返して文書内にレイアウトしますが、何百枚とあるときにはゾッとしますよね。というわけで作ったWordマクロです。

作り方

下記のコードをWord（マクロ有効ファイル）に貼り付けて下さい。A4ページ2段組を想定してサイズの初期設定をしています。

Sub サムネイル貼り込み()
 
Dim myFolderPath,myFileName,myFilePath,myExtension,myDoc As String
Dim FSO As Object

Set myDoc = ActiveDocument
Set FSO = CreateObject("Scripting.FileSystemObject")
myFolderPath = myDoc.Path
  
myFileName = Dir(myFolderPath & "\", vbNormal)
Do While myFileName <> ""
    myExtension = LCase(FSO.GetExtensionName(myFileName))
        Select Case myExtension
            Case "jpg", "png"
            myFilePath = myFolderPath & "\" & myFileName
            With myDoc.Bookmarks("\EndOfDoc").Range
                .InlineShapes.AddPicture FileName:=myFilePath
                .InsertAfter Text:=vbCr & myFileName & vbCr
            End With
            Case Else
       End Select
    myFileName = Dir()
Loop
Set FSO = Nothing
Set myDoc = Nothing

Dim Shp As InlineShape
    For Each Shp In ActiveDocument.InlineShapes
        With Shp
            .LockAspectRatio = msoTrue
            .Height = Application.MillimetersToPoints(48.5)
            .Width = Application.MillimetersToPoints(64.7)
        End With
    Next
End Sub