🙃

【Excel VBA】重なった大量の画像を等間隔に並び替えしたい

2025/01/27に公開

手作業で並べるのはしんどい

作業のエビデンスの為にスクショした写真300枚の並び替えは手に負えなかった。

コード

Sub 画像整え()

    Dim r As Integer
    Dim l As Integer
    Dim t As Integer
    Dim i As Long
    Dim SheetNo As Long

    r = 23 '図を含めた行間隔
    l = 2  '左寄せ列指定(例:B列→2)
    t = 5  '図開始行を指定

    Application.ScreenUpdating = False 

    ' 全シートをループする場合
    For SheetNo = 1 To Worksheets.Count

    ' 特定のシートのみを処理する場合
    ' "Sheet1" を任意シート名に変更
    'For SheetNo = 1 To Worksheets("Sheet1").Index

        With Worksheets(SheetNo)
            For i = 1 To .Shapes.Count 
                .Shapes(i).Left = .Cells(1, l).Left 
                .Shapes(i).Top = .Cells((i) * r, 1).Top 
            Next
            .Range(t & ":" & (r - 1)).Delete 
        End With

    Next

    Application.ScreenUpdating = True

End Sub

※16行目のForと20行目のForは、どちらか片方をコメントアウトして使ってください。

Discussion