VBA Excel Выровнять изображения по горизонтали в нескольких строках

Question

Из некоторого образца кода VBA, который я попытался изменить, я стремлюсь изучить Excel с помощью VBA и надеюсь, что я получу рекомендации по выравниванию изображений по горизонтали, например, 5 изображений в одной строке, а затем начинается новая строка и повторяется. На данный момент я использую жесткое значение 5, просто чтобы это произошло один раз, хотя результаты не такие, как я ожидал. Вот два шага решения проблемы.

1. Кажется, берется первое изображение, а затем сразу создается новая строка
2. Затем вертикально выравнивает два изображения в разных новых строках

Я подумал, что нужен дополнительный счетчик для отслеживания, чтобы макрос знал, когда вводить новую строку.

Sub pictureCode()
'Automatically space and align shapes

Dim shp As Shape
Dim counter As Long
Dim dTop As Double
Dim dLeft As Double
Dim dHeight As Double
Const dSPACE As Double = 50

  'Set variables
  counter = 1

  ActiveSheet.Shapes.SelectAll

  'Loop through selected shapes
  For Each shp In Selection.ShapeRange
    With shp
      'If not first shape then move it below previous shape and align left.
      
      If counter = 5 Then          
        .Top = dTop
        .Left = dLeft + dWidth + dSPACE
      Else
        .Top = dTop + dHeight + dSPACE
        .Left = dLeft
      End If

      'Store properties of shape for use in moving next shape in the collection.
      dTop = .Top
      dLeft = .Left
      dHeight = .Height
    End With

    'Add to shape counter
    counter = counter + 1

  Next shp

End Sub

Answer 1

Попробуйте следующий код, пожалуйста. Он выравнивает фигуры, используя ссылку на строку (Top и Left):

Sub testAlignShapes()
 Dim sh As Worksheet, s As Shape, i As Long, colAlign As Long, startRow As Long
 Dim dWidth As Double, dSpace As Double, rngAlign As Range, iRows As Long, nrShLine As Long
 
 Set sh = ActiveSheet
 colAlign = 9 'column number to align the shapes
 startRow = 2 ' starting row
 nrShLine = 3 'how many shapes on the same row
 iRows = 3 ' after how many rows will start the following shapes row
 
 For Each s In sh.Shapes
    Set rngAlign = sh.cells(startRow, colAlign)
    i = i + 1
    If i <= nrShLine Then
       s.top = rngAlign.top: s.left = rngAlign.left + dWidth + dSpace
       dWidth = dWidth + s.width: dSpace = dSpace + 10
       If i = 3 Then i = 0: dWidth = 0: dSpace = 0: startRow = startRow + iRows
    End If
 Next
End Sub