使用 VBA 宏在 Word 中水平对齐(分布)图像
Align (distribute) images horizontally in Word with VBA macro
这是我第一次在VBA中编写宏。我的目标是编写一个 VBA 宏 ,它将 自动对齐(分布)Word 文档中的所有图像水平(彼此相邻),每个图像的每一侧都有一个小边距。如果没有足够的 space 来容纳另一张图片,我需要它转到下一行(就在之前图片的下方)并继续水平对齐图片。
网上找了很多,都没有找到实现的方法...
注意:我的宏已经包含使所有图像具有相同高度(同时保持相同纵横比)的代码,所以我认为尺寸应该不是问题...
这是我想要实现的一个小例子:
我尝试使用此 link 中的水平对齐代码:https://www.excelcampus.com/vba/align-space-distribute-shapes/
但我得到了以下结果:
边距很奇怪,形状无限对齐,而不是进入下一行...
我的代码:
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dWidth As Double
Const dSPACE As Double = 8 'Set space between shapes in points
lCnt = 1
Dim image As Shape
If ActiveDocument.Shapes.Count > 0 Then
For Each image In ActiveDocument.Shapes
With image
.WrapFormat.Type = wdWrapSquare
.LockAspectRatio = msoTrue
.Height = InchesToPoints(3)
If lCnt > 1 Then
.Top = dTop
.Left = dLeft + dWidth + dSPACE
End If
dTop = .Top
dLeft = .Left
dWidth = .Width
End With
lCnt = lCnt + 1
Next
End If
End Sub
提前致谢!
由于您是 VBA 的新手,如果您要采用 Table 方法,我想分享一些代码。下面的代码创建了一个宽度固定的单行 table,除非您更改单个单元格,否则不会横向扩展。仅出于演示目的,我将相同的图片插入每个单元格以演示图像根据单元格宽度自动调整大小。
Sub TableOfPictures()
Dim doc As Word.Document, rng As Word.Range
Dim Tbl As Word.Table, C As Long
Set doc = ActiveDocument
Set rng = Selection.Range
Set Tbl = rng.Tables.Add(rng, 1, 2, Word.WdDefaultTableBehavior.wdWord8TableBehavior)
Tbl.rows(1).Cells(1).Width = InchesToPoints(2)
Tbl.rows(1).Cells(2).Width = InchesToPoints(4.5)
For C = 1 To 2
Tbl.rows(1).Cells(C).Range.InlineShapes.AddPicture ("Y:\Pictures\Mk45 Gun Proj_Blast.jpg")
Next
End Sub
将您的图像插入具有固定单元格尺寸的 table 不会达到您所说的效果,因为图像显然没有相同的宽高比。您需要做的是将它们转换为内联形状,以便 Word 可以处理换行。例如:
Sub Demo()
Application.ScreenUpdating = False
Dim iShp As InlineShape
With ActiveDocument
Do While .Shapes.Count > 0
.Shapes(1).ConvertToInlineShape
Loop
For Each iShp In .InlineShapes
With iShp
.LockAspectRatio = True
.Height = InchesToPoints(3)
If .Range.Characters.Last.Next <> " " Then .Range.InsertAfter " "
End With
Next
End With
Application.ScreenUpdating = True
End Sub
您可以通过更改段落行间距来调整图像之间的垂直间距。另请注意,可以通过在左对齐、居中和对齐段落格式之间切换来调整水平对齐方式。
这是我第一次在VBA中编写宏。我的目标是编写一个 VBA 宏 ,它将 自动对齐(分布)Word 文档中的所有图像水平(彼此相邻),每个图像的每一侧都有一个小边距。如果没有足够的 space 来容纳另一张图片,我需要它转到下一行(就在之前图片的下方)并继续水平对齐图片。
网上找了很多,都没有找到实现的方法...
注意:我的宏已经包含使所有图像具有相同高度(同时保持相同纵横比)的代码,所以我认为尺寸应该不是问题...
这是我想要实现的一个小例子:
我尝试使用此 link 中的水平对齐代码:https://www.excelcampus.com/vba/align-space-distribute-shapes/
但我得到了以下结果:
我的代码:
Dim lCnt As Long
Dim dTop As Double
Dim dLeft As Double
Dim dWidth As Double
Const dSPACE As Double = 8 'Set space between shapes in points
lCnt = 1
Dim image As Shape
If ActiveDocument.Shapes.Count > 0 Then
For Each image In ActiveDocument.Shapes
With image
.WrapFormat.Type = wdWrapSquare
.LockAspectRatio = msoTrue
.Height = InchesToPoints(3)
If lCnt > 1 Then
.Top = dTop
.Left = dLeft + dWidth + dSPACE
End If
dTop = .Top
dLeft = .Left
dWidth = .Width
End With
lCnt = lCnt + 1
Next
End If
End Sub
提前致谢!
由于您是 VBA 的新手,如果您要采用 Table 方法,我想分享一些代码。下面的代码创建了一个宽度固定的单行 table,除非您更改单个单元格,否则不会横向扩展。仅出于演示目的,我将相同的图片插入每个单元格以演示图像根据单元格宽度自动调整大小。
Sub TableOfPictures()
Dim doc As Word.Document, rng As Word.Range
Dim Tbl As Word.Table, C As Long
Set doc = ActiveDocument
Set rng = Selection.Range
Set Tbl = rng.Tables.Add(rng, 1, 2, Word.WdDefaultTableBehavior.wdWord8TableBehavior)
Tbl.rows(1).Cells(1).Width = InchesToPoints(2)
Tbl.rows(1).Cells(2).Width = InchesToPoints(4.5)
For C = 1 To 2
Tbl.rows(1).Cells(C).Range.InlineShapes.AddPicture ("Y:\Pictures\Mk45 Gun Proj_Blast.jpg")
Next
End Sub
将您的图像插入具有固定单元格尺寸的 table 不会达到您所说的效果,因为图像显然没有相同的宽高比。您需要做的是将它们转换为内联形状,以便 Word 可以处理换行。例如:
Sub Demo()
Application.ScreenUpdating = False
Dim iShp As InlineShape
With ActiveDocument
Do While .Shapes.Count > 0
.Shapes(1).ConvertToInlineShape
Loop
For Each iShp In .InlineShapes
With iShp
.LockAspectRatio = True
.Height = InchesToPoints(3)
If .Range.Characters.Last.Next <> " " Then .Range.InsertAfter " "
End With
Next
End With
Application.ScreenUpdating = True
End Sub
您可以通过更改段落行间距来调整图像之间的垂直间距。另请注意,可以通过在左对齐、居中和对齐段落格式之间切换来调整水平对齐方式。