VBA Excel在多行中水平对齐图片

Posted 2023-03-05

【中文标题】VBA Excel在多行中水平对齐图片

【英文标题】：VBA Excel Align Pictures Horizontally in Multiple Rows

【发布时间】：2020-11-27 13:44:47

【问题描述】：

从我尝试修改的一些示例 VBA 代码中， 我的目标是使用 VBA 学习 Excel，并希望获得指导以水平对齐图片，例如一行中的 5 张图片，然后在新行下方开始并重复。现在我使用硬值 5，只是为了让它发生一次，尽管结果不是我所期望的。这是问题的两个步骤

似乎先拍摄第一张照片，然后马上换一个新行 然后在不同的新行上垂直对齐两个图像

我考虑需要一个额外的计数器来跟踪，以便宏知道何时引入新行。

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

【问题讨论】：

以 Cells 为参考就好了...

【参考方案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

【讨论】：

感谢您在代码中提供的帮助 cmets！我会玩弄你提供给我的样本！

@Brandon Falk：很高兴我能帮上忙！它应该做你需要的（我理解）......