使用 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

您可以通过更改段落行间距来调整图像之间的垂直间距。另请注意,可以通过在左对齐、居中和对齐段落格式之间切换来调整水平对齐方式。