MENU

【エクセルVBA】画像を一括で貼り付け

VBA
当ページのリンクには広告が含まれています。

スポンサーリンク

VBAを使って、指定したフォルダの画像を一括で整列させて貼り付ける方法を紹介します

レポート作成などで、写真を 一気に 整列させて 取り込みたい 時などに役立ちます。

動画を見ればイメージできるかと思います

クリックしてジャンプ

イメージ動画（音声はありません）

サンプルダウンロード

説明に使用しているエクセルファイルです

デモ用の画像も入っています

vba – 画像貼り付け.zip

下図のような表示が出た場合は、以下の手順でマクロを有効にできます。

  1. 一度、エクセルを閉じる
  2. ダウンロードしたエクセルファイルを「右クリック」
  3. 「プロパティ」を選択
  4. 「全般」タブのセキュリティの「許可する」に ✓
  5. 「適用」ボタンをクリック
  6. 「OK」ボタンをクリック

VBAコード

スクリプトの概要

ユーザーが選択したフォルダ内の画像ファイル（JPGおよびPNG形式）をExcelシートに自動的に挿入し、指定した高さで統一して配置します。

画像は、ユーザーが指定した行と列から始まり、指定された列数に達すると次の行に移動します。

画像間の列方向および行方向の間隔もユーザーが指定できます。

画像を貼り付ける順番は ファイルの名前順 になります。Dir関数を使用してフォルダ内のファイルを読み込むと、ファイルはアルファベット順（またはファイルシステムが保持している順番）に取得されるためです。

コード

Sub 画像貼り付け()

    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' フォルダ選択ダイアログを表示
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "画像フォルダの選択"
    Dim imgFolder As String
    If fd.Show = -1 Then
        imgFolder = fd.SelectedItems(1)
    Else
        MsgBox "フォルダが選択されませんでした。", vbExclamation
        Exit Sub
    End If
    
    ' パラメータの取得
    Dim imgHeight As Double
    Dim insertRow As Long, insertCol As Long
    Dim numCols As Long
    Dim colSpacing As Double, rowSpacing As Double
    imgHeight = ws.Range("A2").Value ' 画像の高さ
    insertRow = ws.Range("B2").Value
    insertCol = ws.Range("C2").Value
    numCols = ws.Range("D2").Value
    colSpacing = ws.Range("E2").Value
    rowSpacing = ws.Range("F2").Value
    
    ' 初期位置の設定
    Dim insertTop As Double, insertLeft As Double
    insertTop = ws.Cells(insertRow, insertCol).Top
    insertLeft = ws.Cells(insertRow, insertCol).Left
    
    ' 画像の配置
    Dim file As String, currentCol As Long, rowCounter As Long
    currentCol = 0
    rowCounter = 0
    
    file = Dir(imgFolder & "\*.*")
    Do While file <> ""
        If Right(file, 3) = "jpg" Or Right(file, 3) = "png" Then
            With ws.Pictures.Insert(imgFolder & "\" & file)
                .ShapeRange.LockAspectRatio = msoTrue
                .Height = imgHeight ' 画像の高さを統一
                .Top = insertTop + (rowCounter * (imgHeight + rowSpacing))
                .Left = insertLeft + (currentCol * (colSpacing + .Width))
                
                currentCol = currentCol + 1 ' 次の列へ
                If currentCol >= numCols Then ' 指定された列数に達したら次の行へ
                    currentCol = 0
                    rowCounter = rowCounter + 1
                End If
            End With
        End If
        file = Dir()
    Loop
    
End Sub

解説

  1. フォルダ選択:
    • FileDialogを使用して、画像が保存されているフォルダをユーザーに選択させます。
  2. パラメータの設定:
    • Excelシートのセルから各種パラメータを参照します。
    • 画像の高さ（A2）、開始位置（B2行、C2列）、列数（D2）、列方向の間隔（E2）、行方向の間隔（F2）
  3. 画像の配置:
    • 選択されたフォルダ内のすべてのJPGおよびPNGファイルをループ処理し、指定された高さで統一してシート上に配置します。
    • 画像は、指定された開始位置から始まり、指定された間隔で並べられます。
    • 指定された列数に達すると、自動的に次の行に移動します。

特徴

  • アスペクト比の保持: .ShapeRange.LockAspectRatio = msoTrueにより、画像のアスペクト比を保持しながら高さを統一。
  • 動的配置: 指定された列数に基づいて画像を列方向および行方向に配置し、整理されたビジュアルを作成。
  • ユーザーフレンドリー: フォルダ選択ダイアログやExcelシート上でのパラメータ入力により、コードの変更なしに異なる要件に対応。

スポンサーリンク

VBA
クリックしてジャンプ