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

如何解决使用 VBA 宏在 Word 中水平对齐分布图像

这是我第一次用 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

提前致谢！

解决方法

由于您是 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

,

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

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