VBA Excel 多行水平对齐图片
VBA Excel Align Pictures Horizontally in Multiple Rows
从我尝试修改的一些样本 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
请尝试下一个代码,它使用行引用对齐形状(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
从我尝试修改的一些样本 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
请尝试下一个代码,它使用行引用对齐形状(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