如果满足条件，将Word中的段落复制到下一页(宏) [英] Copy paragraphs from Word into the next page if the condition is met (macro)

问题描述

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

I am trying to create macro which is going to export data from Excel file into Word document with specific conditions. Each row in the table has photos attached - sometimes 1 and sometimes more. I would like to paste text from the table and then the photo below. If my current row has more than 1 photo attached, then I would like to copy the same text to the next page and paste next photo below. As a result I will have 1 photo per page with the description.

现在我有一个代码，可以通过计算两个前几个数字来检查照片的名称(例如:66_foto1.jpg，66_foto2.jpg，67_foto1.jpg)，但是我不确定如何在下一个开始时复制文本页面.

For now I have a code which is checking photo's name by counting two first numbers (example: 66_foto1.jpg, 66_foto2.jpg, 67_foto1.jpg) but I am not sure how to copy the text at the begining of the next page.

部分代码:

   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，但我想创建变量并计算不同的变量.

For now there is just photo no. 66, but I would like to make variables and count different ones.

推荐答案

将文本和图片粘贴到两行表中，第一行标记为标题行.此后，任何导致新行在新页面上开始的操作都将复制该页面上的标题行.不需要文本复制代码；如果需要的话，以后更新也更容易.

Paste both the text and the picture into a two-row table, with the first row marked as a header row. Thereafter, anything that causes a new row to start on a new page will replicate the header row on that page. No text replication code required; it's also simpler to update later if needed.

例如(作为Word宏-即不是从Excel自动执行，我将留给您):

For example (as a Word macro - i.e. not automated from Excel, which I'll leave to you):

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文本".按照编码，图片尺寸会按照正确的纵横比自动限制为6in * 6in.

The above code will insert all the 66_*.jpg pics and have the 'Excel text' appear above each pic. As coded, pic sizes are automatically limited to 6in*6in at their correct aspect ratios.

请注意:StackOverflow不是免费的编码论坛.

Please note: StackOverflow is not a free coding forum.

这篇关于如果满足条件，将Word中的段落复制到下一页(宏)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！