如果满足条件，将 Word 中的段落复制到下一页（宏）

Question

我正在尝试创建将数据从 Excel 文件导出到具有特定条件的 Word 文档的宏。表格中的每一行都附有照片 - 有时 1 有时更多。我想粘贴表格中的文本，然后粘贴下面的照片。如果我的当前行附加了超过 1 张照片，那么我想将相同的文本复制到下一页并粘贴下面的下一张照片。因此，我每页将有 1 张带有描述的照片。

现在我有一个代码，它通过计算前两个数字来检查照片的名称（例如：66_foto1.jpg、66_foto2.jpg、67_foto1.jpg），但我不知道如何在下一个开头复制文本页面。

部分代码：

   Dim fso As Object
    Dim objfolder As Object
    Dim objfile As Object
    Dim lCount As Long 'number of photo starts with 66_
    Dim strpath As String
    Dim objsub As Object
    strpath = "C:\xxx\photos" 'path where photos are located
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objfolder = fso.GetFolder(strpath)
    For Each objfile In objfolder.Files
    If UCase(objfile.Name) Like "66_*" Then lCount = lCount + 1
    Next objfile

    Dim imagePath As String

    For i = 1 To lCount
    imagePath = "C:\xxx\photos\" & "66_" & "Foto " & i & ".jpg"
        objWord.Selection.InlineShapes.AddPicture Filename:= _
        imagePath, LinkToFile:=False, _
        SaveWithDocument:=True
        objWord.Selection.TypeParagraph
    Next

现在只有照片编号。 66，但我想制作变量并计算不同的变量。

Answer 1

将文本和图片都粘贴到一个两行表格中，第一行标记为标题行。此后，任何导致新行在新页面上开始的任何内容都将复制该页面上的标题行。无需文本复制代码；如果需要，以后更新也更简单。

例如（作为 Word 宏 - 即不是从 Excel 自动化，我将留给您）：

Sub AddPics()
Application.ScreenUpdating = False
Dim wdDoc As Word.Document, wdTbl As Word.Table, strPic As String, r As Long
Const strFldr As String = "C:\xxx\photos\": r = 1
Set wdDoc = ActiveDocument
With wdDoc
  Set wdTbl = .Tables.Add(Range:=.Bookmarks("MyBookmark").Range, NumRows:=1, NumColumns:=1)
  With wdTbl
    .Rows.Alignment = wdAlignRowCenter
    .PreferredWidthType = wdPreferredWidthPoints
    .PreferredWidth = InchesToPoints(6)
    .Range.Cells(1).Range.Text = "Excel text"
    strPic = Dir(strFldr & "66_*.jpg", vbNormal)
    Do While strPic <> ""
      r = r + 1
      .Rows.Add
      With .Rows(r)
        .HeightRule = wdRowHeightExactly
        .Height = InchesToPoints(6)
        .AllowBreakAcrossPages = False
        .Range.InlineShapes.AddPicture FileName:=strFldr & strPic, Range:=.Cells(1).Range
      End With
    strPic = Dir()
    Loop
    .Rows(1).HeadingFormat = True
  End With
End With
Application.ScreenUpdating = True
End Sub

以上代码将插入所有 66_*.jpg 图片，并在每张图片上方显示“Excel 文本”。按照编码，图片大小在正确的纵横比下自动限制为 6 英寸 * 6 英寸。

请注意：StackOverflow 不是免费的编码论坛。