Excelで画像が重なる問題を解決｜VBAで一括整列する方法

#プログラム #ツール

記事をシェア：

コピー

こんにちは。飯塚です。

手順書を作成したり、エビデンスをまとめる際に、Excelへ画像を一括挿入することがあります。その際に困るのが、画像が重なってしまう問題です。「オブジェクトの配置」を使っても画像の重なりは解消されないので、意外と手間がかかります。

重なりを解消して等間隔に配置するVBAを作ったのでコードの内容と使い方を記事にしました。

Excelで一括挿入した画像の重なりを解消して、縦に整列するイメージ

VBAの実行結果は下記のイメージです。

画像のサイズが異なっていても縦に並びます。厳密に等間隔ではなく、各画像の先頭がセル上に配置されるようにしています。業務では番号や文章を補足することが多いので、位置をセルに揃えたほうが使いやすいだろうと考えました。

画像を縦に整列するVBAコード

選択した画像がセル上で整然と縦に並ぶよう、必要な計算を行っています。

Sub haichi()
    On Error GoTo ErrorHandler

    ' 画像をループ処理するための一時変数'
    Dim pic As Shape
    ' 選択された画像を格納する配列'
    Dim selectedPictures() As Shape
    ' 画像の枚数'
    Dim pictureCount As Long
    ' 画像間のスペース（行間隔）'
    Dim spacing As Double
    ' 画像配置時の上端位置'
    Dim topPosition As Double
    ' ループカウンタ'
    Dim i As Long
    ' 画像の最上部の位置（配置開始位置）'
    Dim minTop As Double
    ' 画像の配置先の左端位置'
    Dim posLeft As Double
    ' 画像数を初期化'
    pictureCount = 0

    ' シート上の全シェイプをループ'
    For Each pic In ActiveSheet.Shapes
        ' 画像タイプのみカウント'
        If pic.Type = msoPicture Then
            pictureCount = pictureCount + 1
            ' 配列サイズを動的に変更'
            ReDim Preserve selectedPictures(1 To pictureCount)
            ' 配列に画像をセット'
            Set selectedPictures(pictureCount) = pic
        End If
    Next pic

    ' 画像が2つ未満なら処理中断'
    If pictureCount < 2 Then
        MsgBox "2つ以上の画像を選択してください。", vbExclamation
        Exit Sub
    End If

    ' 最上部の位置を初期化'
    minTop = selectedPictures(1).Top

    ' 最小Top位置を探索'
    For i = 1 To pictureCount
        If selectedPictures(i).Top < minTop Then
            minTop = selectedPictures(i).Top
        End If
    Next i

    ' 左端の固定位置を設定'
    posLeft = 54
    ' 画像間のスペースを設定'
    spacing = 18.75
    ' 配置開始位置を設定'
    topPosition = minTop

    ' 画像を縦方向に等間隔で配置'
    For i = 1 To pictureCount
        selectedPictures(i).Top = topPosition
        selectedPictures(i).Left = posLeft
        topPosition = topPosition + selectedPictures(i).Height
        ' spacing単位で切り上げて次の配置位置を決定'
        topPosition = (WorksheetFunction.RoundUp(topPosition / spacing, 0) + 1) * spacing
    Next i

    MsgBox "画像が縦方向に等間隔に配置されました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました。" & vbNewLine & _
           "エラー番号: " & Err.Number & vbNewLine & _
           "エラーの説明: " & Err.Description, vbCritical, "エラー"
End Sub

WordPress上で読みやすくするために「'」をコメント末尾にもつけています。VBAコードにはあってもなくても影響ありません。

Excelに画像を挿入してVBAを実行する手順

1. 画像を配置したい先頭位置のセルを選択

2.「挿入タブ」>「画像」＞「セルの上に配置」>「このデバイス」

3. 対象の画像をポップアップから選択
　なお、Excelの仕様上、並び替えた順に画像が挿入されます。おそらく日付時刻が古い順に挿入することが多いので、日付時刻で並び替えてから挿入しています。

4.「画像を縦に再配置」ボタンを押してVBAを実行
　VBA実行用のボタン配置の手順は割愛します。

5.画像が縦に等間隔に再配置される

まとめ

いかがでしょうか。

スマホで撮った大量のエビデンス用スクリーンショットを、後輩社員がExcelに手作業で一生懸命に配置しているのを見たことがありました。生産性が低いわりに時間がかかるため、作業者にも大きな負担がかかっていると感じました。少しでも負担が減らせないかと思い、今回のVBAを作成しました。

同様の作業で困っている方のお役に立てば幸いです。

《関連記事》