Search code examples
excelvbaimagealignment

VBA Excel Align Pictures Horizontally in Multiple Rows


From some sample VBA code I attempted to modify, I am aiming to learn Excel using VBA and hoping for guidance to align Pictures horizontally such as 5 pictures in one row then below a new row begins and repeat. For now I am using a hard value of 5, just to have it occur once though the results aren't what I expected. Here are two steps of the problem

  1. Seems to take the first image then make a new row right away
  2. Then vertically aligns two images on different new rows

I considered needing an additional counter to keep track of so the Macro will know when to introduce a new row.

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

Solution

  • Try the next code, please, It aligns shapes using the row reference (Top and 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