Word 宏:Import/format 个文件夹中的图像并删除多余的页面

Word Macro: Import/format images from folder & delete extra pages

我对宏完全陌生,我正在尝试执行以下操作:

将硬盘驱动器上文件夹中的所有图像导入 Word 文件 - 每个图像都有自己的页面并调整大小以填充页面(A4 纵向),同时仍保持其比例。

我已经成功地完成了 "import" 部分,每张图片都有自己的页面,代码如下:

Sub BilderImport()
    Dim Path As String
    Dim Img As Object
    Dim fs As Object
    Dim f As Object
    Dim fc As Object
    Dim i As Integer
    Dim fsize As Integer

    Path = "C:\tmp"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(Path)
    Set ff = f.Files
    i = 0
    fsize = ff.Count

    For Each Img In ff
        If Right(Img.Name, 4) = ".bmp" Or Right(Img.Name, 4) = ".jpg" Or Right(Img.Name, 4) = ".gif" Or Right(Img.Name, 4) = ".png" Then
            i = i + 1
            Selection.InlineShapes.AddPicture FileName:=Img 

            Selection.InsertBreak Type:=wdLineBreak 'Add file name below every img
            Selection.TypeText Text:=Img.Name

            If i < fsize Then 'No line break after the last img
                Selection.InsertBreak Type:=wdPageBreak 'Inserts line break after every img
            End If
        End If
    Next
End Sub

我现在遇到的一个问题:Word还会在每张图片后添加一个换行符,如果图片已经很高了,这个换行符会跳转到下一页,这会添加一个额外的空白页,因为打破我已经添加了。

如何防止或检查它?

有两种解决方法。我更喜欢两者的结合:

  • 如果您要调整图像大小,请将它们调整得更小一点(考虑到额外的换行符)
  • 在添加图片之前将字体大小设置为 0 或 1,并将段落设置为小行高

根据图像大小,第二点就足够了。

还有第三种可能:输入图片前后都要检查页数。但这会减慢整个宏的速度。

尝试:

Sub BilderImport()
    Dim Path As String
    Dim fs As Object
    Dim ff As Variant
    Dim Img As Variant
    Dim i As Long
    Dim fsize As Long

    Path = "C:\tmp"
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ff = fs.GetFolder(Path).Files
    i = 0
    fsize = ff.Count
    With ActiveDocument
        For Each Img In ff
            Select Case Right(Img.Name, 4)
                Case ".bmp", ".jpg", ".gif", ".png"
                    i = i + 1
                    .Characters.Last.InlineShapes.AddPicture FileName:=Img
                    .Characters.Last.InsertBefore Chr(11) & Img.Name & Chr(12)                End Select
        Next
        'No page break after last pic
        .Characters.Last.Previous.Delete
    End With
End Sub