Copy paragraphs from Word into the next page if the condition is met (macro)

Question

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.

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.

Part of the code:

   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

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

How can I copy text from one page in Word into the next page? (I would like to select all text from the page (but only text) and copy it in the same format. — AngelaG

macropod macropod · Accepted Answer · 2019-12-03T11:10:59

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.

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

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.

Please note: StackOverflow is not a free coding forum.

Copy paragraphs from Word into the next page if the condition is met (macro)

1 Answers