使用 VBA 宏在 Word 中水平对齐（分布）图像

Question

这是我第一次在 VBA 中编写宏。我的目标是编写一个 VBA 宏，它将自动对齐（分布）Word 文档中的所有图像（彼此相邻），并在每张图片的每一面。如果没有足够的空间容纳另一张图片，我需要它转到下一行（就在之前的图片下方）并继续水平对齐图片。

我在互联网上搜索了很多，但我没有找到实现此目的的方法......

注意：我的宏已经包含使所有图像具有相同高度（同时保持相同纵横比）的代码，所以我认为尺寸应该不是问题...

这是我想要实现的一个小例子：

我尝试使用此链接中的水平对齐代码：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

提前致谢！

Answer 1

将您的图片插入到具有固定单元格尺寸的表格中不会达到您想要的效果，因为这些图片显然没有相同的纵横比。您需要做的是将它们转换为内联形状，以便 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

您可以通过更改段落行间距来调整图像之间的垂直间距。还要注意，水平对齐可以通过在左、居中和两端对齐的段落格式之间切换来进行。

Answer 2

由于您是 VBA 新手，如果您要采用 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