【ExcelVBA】大量の画像を複数のExcelシートに自動で貼り付ける方法

皆さんは大量の画像をExcelに貼り付ける場合どのようしていますか？

例えば下の様式に写真を貼り付けていく作業があるとします。

Excelに内蔵されているプログラミング言語を使えば、このような作業を一瞬で終わらせることができます。

本記事では、プログラムをコピペするだけで動作確認ができるように心がけています。

ですからプログラムなんて分からないという方でもご安心下さい。

ではさっそくやってみましょう。

手順①　プログラムを貼り付ける画面を表示
手順②　プログラムのコピー
手順③　プログラムの貼り付け
手順④　プログラムの実行
実行結果
まとめ

手順①　プログラムを貼り付ける画面を表示

まずはこちらの記事の手順を実行して、プログラムを貼り付ける画面を表示します。

【ExcelVBA】プログラミングする方法

Excelには業務効率化のための強力プログラミング言語が搭載されています。この記事ではそのプログラミング言語を使用するための方法を分かりやすく丁寧にご紹介します。

手順②　プログラムのコピー

次にこのプログラムをコピーします。

Sub pasteImage()
    
    ' 貼り付ける画像が格納されているフォルダを選択します
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            ' 取得したフォルダパスを変数に入れる
            folderPath = .SelectedItems(1)
        End If
    End With
    
    ' フォルダ内の画像パスを格納する配列を用意します
    Dim imagePath() As Variant
    ReDim imagePath(0)
    ' 1枚目の画像パスを配列に入れます
    imagePath(0) = Dir(folderPath & "\")
    
    ' 配列の画像パスのインデックス
    idx = 0
    
    ' フォルダ内の画像の枚数分繰り返す
    Do While imagePath(idx) <> ""
        ' 配列に画像のパスを格納する
        idx = idx + 1
        ' 配列を再定義します
        ReDim Preserve imagePath(idx)
        ' 配列に画像のパスを格納します
        imagePath(idx) = Dir()
    Loop
    
    ' 貼り付ける画像のインデックス
    pIdx = 0
    
    ' シートの繰り返し
    For Each sh In ThisWorkbook.Worksheets
        ' 画像を４枚貼り付けます
        For i = 1 To 4
            ' 貼り付け先のセルを指定します
            Select Case i
                Case 1
                    targetRange = "B2:D2"
                Case 2
                    targetRange = "I2:K2"
                Case 3
                    targetRange = "B12:D12"
                Case 4
                    targetRange = "I12:K12"
            End Select
            ' 画像の貼り付け
            sh.Activate
            With ActiveSheet.Pictures.Insert(folderPath & "\" & imagePath(pIdx))
                ' 画像の位置を指定
                .Top = Range(targetRange).Top
                .Left = Range(targetRange).Left
                ' 画像の横幅を指定
                .Width = Range(targetRange).Width
            End With
            pIdx = pIdx + 1
        Next
    Next
        
End Sub