VBA｜写真・画像が自動的に整列するマクロ

エクセルのワークシート上に画像や写真をアルバムのように貼り付けた後、いらない画像を削除して穴開き状態になったものを写真を順番を変えないで整列させるマクロです。

写真・画像が自動的に整列するマクロ

Sub 画像整列()
   
   Dim shp_rng As Range
   Dim inp, inp_a, inp_n As Range
   Dim i As Long

   ''開始セルの選択
   On Error Resume Next
   Set inp_a = Application.InputBox(prompt:="マウスで始点セルを選択", _
                                   Title:="始点セルを選択", _
                                   Default:="マウスで始点セルを選択", _
                                   Type:=8)
   If Err.Number = 0 Then
      MsgBox myrange.Address
   Else
      MsgBox "キャンセルしました"
      Exit Sub
   End If
    
   ''終了セルの選択
   On Error Resume Next
   Set inp_b = Application.InputBox(prompt:="マウスで終点セルを選択", _
                                   Title:="終点セルを選択", _
                                   Default:="マウスで終点セルを選択", _
                                   Type:=8)
   If Err.Number = 0 Then
      MsgBox myrange.Address
   Else
      MsgBox "キャンセルしました"
      Exit Sub
   End If
   
   ''整列させるマクロ
   Dim kuuhaku_cell As Range
   Dim flag As Long
   Dim f, g As Long
   Dim s As Long
   
   j = inp_a.Row
   k = inp_a.Column
   
   flag = 0
   
   For f = j To 20 ''画像が貼ってある最終行数にしてください
      For g = k To 5 ''画像が貼ってある列数にしてください
         For s = 1 To ActiveSheet.Shapes.Count
            With ActiveSheet.Shapes(s)
            Set shp_rng = Range(.TopLeftCell, .BottomRightCell)
         
            If Intersect(ActiveSheet.Cells(f, g), shp_rng) Is Nothing Then
               If flag = 0 Then
                  Set kuuhaku_cell = Cells(f, g)
                  flag = 1
               End If
            Else
               If flag = 1 Then
                  ActiveSheet.Shapes(s).Left = kuuhaku_cell.Left
                  ActiveSheet.Shapes(s).Top = kuuhaku_cell.Top
                  .Left = .Left + (kuuhaku_cell.Width - .Width) / 2
                  .Top = .Top + (kuuhaku_cell.Height - .Height) / 2
                  flag = 0
                  f = kuuhaku_cell.Row
                  g = kuuhaku_cell.Column
                  Exit For
               Else
                  Exit For
               End If
            End If
            End With
         Next s
         If (f >= inp_b.Row) And (g >= inp_b.Column) Then
            Exit For
         End If
      
         g = g + 1
         If g > 5 Then  ''アルバムの列数にしてください。
            g = 1
            f = f + 1
         End If
         g = g - 1
      Next g
   
      If (f >= inp_b.Row) And (g >= inp_b.Column) Then
         Exit For
      End If
      f = f - 1
   Next f

End Sub

このVBAの特徴として、整列の範囲を決められることです。
マクロを実行すると、「整列を開始セル」と「整列の終了セル」を入力（セルを選択）するように入力ボックスが表示されます。

「始点セル」及び「終点セル」をそれぞれ任意のセルを選択（クリック）した後、「OK」を押すと、整列が実行されます。

画像を貼る範囲に応じて、プログラムを変更することはもちろん可能で、以下のとおりに変更します。

• 行数　→44行目　 For f = j To 20 　の数字を画像が貼ってある最大の行数に変更
• 列数　→45行目　 For g = k To 5 　の数字を画像が貼ってある最大の列数に変更
  　　　　76行目　 If g > 5 Then 　　の数字を画像が貼ってある最大の列数に変更

ちなみにプログラムの解説ですが、
各セルと図形のRange(.TopLeftCell, .BottomRightCell)を、intersectで交差を比較しています。
もし、セルと図形が交差していなければ、空白セルとして位置を記憶し、次の図形を見つけたら（intersectで交差があれば）、先ほど記憶した空白セルに画像を移動させます。
そのようにして、最初に入力ボックスで選択したセルの範囲を走査します。

エクセルを写真アルバムのようにして使う場面の少なくないですので、その際に役立てていただければと思います。

参考：Excel VBA入門 その69：グループ化したオブジェクト(図形)のグループ名の取得・設定方法