Search code examples
excelvbams-word

Insert page break in Word document using macro in Excel


I am trying to have my macro make three tables in Word. It currently makes one big table and formats it correctly, but I can't find how to force a page break at the desired times. I found a macro that was using vba in Word and they used .InsertBreak but this keeps causing an error when I run it.

Here is my code at present. It's pieced together from a lot of sources with bits of my own chucked in there;

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl As Word.Table
Dim xlSht As Worksheet
Dim lRow As Integer
Dim lCol As Integer
Dim r As Integer
Dim c As Integer
Dim Blanks As Integer
Dim First As Integer
Dim Second As Integer

lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2


Blanks = 0
i = 1
    Do While i <= lRow
    Set rRng = Worksheets("Feedback Sheets").Range("A" & i)

        If IsEmpty(rRng.Value) Then
        
            Blanks = Blanks + 1
            
                If Blanks = 1 Then First = i
                If Blanks = 2 Then Second = i
                
        End If
        
        i = i + 1
    Loop
'Now I know where end of each table is

Set xlSht = ActiveSheet: lCol = 5
With wdApp
  .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = 1 To lRow
        If (r + 1) > wdTbl.Rows.Count Then wdTbl.Rows.Add
        If r = First Then wdDoc.InsertBreak

        If r = Second Then wdDoc.InsertBreak

        For c = 1 To lCol
          wdTbl.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

Set wdTbl = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing

When I run it I get runtime error '438', object doesn't support this property or method and the Debug highlights this line;

If r = First Then wdDoc.InsertBreak

which is why I think it's the InsertBreak that is the issue.

Edit: I have now managed to get it to make three tables with page breaks after each table, but over three different documents (and probably in the most clunky way possible). When I remove the Set wdDoc = .Documents.Add line from the second and third iterations of that block of code it just creates table 3. I feel like it might have the table selected after applying the formatting and then overwriting it with the next table, but setting Set myTable = Nothing ruins everything.

Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
Dim wdTbl1 As Word.Table
Dim wdTbl2 As Word.Table
Dim wdTbl3 As Word.Table
Dim xlSht As Worksheet
Dim lRow As Integer
Dim lCol As Integer
Dim r As Integer
Dim c As Integer
Dim Blanks As Integer
Dim First As Integer
Dim Second As Integer

lRow = Sheets("Feedback Sheets").Range("A1000").End(xlUp).Row - 2


Blanks = 0
i = 1
    Do While i <= lRow
    Set rRng = Worksheets("Feedback Sheets").Range("A" & i)

        If IsEmpty(rRng.Value) Then
        
            Blanks = Blanks + 1
            
                If Blanks = 1 Then First = i
                If Blanks = 2 Then Second = i
                
        End If
        
        i = i + 1
    Loop
'Now I know where end of each table is

Set xlSht = ActiveSheet: lCol = 5
With wdApp
  .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl1 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl1
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = 1 To First
        If (r + 1) > wdTbl1.Rows.Count Then wdTbl1.Rows.Add
        If r = First Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak
        For c = 1 To lCol
          wdTbl1.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c

      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With


  
With wdApp
 .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl2 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl2
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = First To Second
        If (r + 1) > wdTbl2.Rows.Count Then wdTbl2.Rows.Add

        If r = Second Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak

        For c = 1 To lCol
          wdTbl2.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With

With wdApp
 .Visible = True
  Set wdDoc = .Documents.Add
  With wdDoc
    Set wdTbl3 = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=lCol)
    With wdTbl3
      .Rows(1).Range.Font.Bold = True
      .Rows(1).HeadingFormat = True
      .Cell(1, 1).Range.Text = "Header 1"
      If lCol > 1 Then .Cell(1, 2).Range.Text = "Header 2"
      If lCol > 2 Then .Cell(1, 3).Range.Text = "Header 3"
    End With
    With xlSht
      For r = Second To lRow
        If (r + 1) > wdTbl3.Rows.Count Then wdTbl3.Rows.Add

        If r = Second Then wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak

        For c = 1 To lCol
          wdTbl3.Cell(r + 1, c).Range.Text = xlSht.Cells(r, c).Text
        Next c
      Next r
    End With
  End With
End With

Set myTable = ActiveDocument.Tables(1)
With myTable.Borders
 .InsideLineStyle = wdLineStyleSingle
 .OutsideLineStyle = wdLineStyleDouble
End With


Set wdTbl1 = Nothing: Set wdTbl2 = Nothing: Set wdTbl3 = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing: Set xlSht = Nothing

Edit 2: This seems to have strayed too far from the original question so I'll mark this one as done and ask a new one.


Solution

  • wdDoc.InsertBreak is invalid, as you would know if you're using IntelliSense, because the document object does not have an InsertBreak method.

    InsertBreak is a method of the Range object. As you want to place the break after the table you should use:

    wdDoc.Characters.Last.InsertBreak Type:=wdPageBreak