0

I'm trying to write a code to transfer an Excel file to Word with proper formatting, but when I set the format for one row, it gets applied to the next row instead.

Sub ExportToWordModifiedExcelData()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim i As Integer
    Dim colA As String, colB As String, colC As String, colD As String
    Dim cycleCount As Integer 

   
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
    End If
    On Error GoTo 0

   
    Set wdDoc = wdApp.Documents.Add
    wdApp.Visible = True

    
    header1 = "IV. 31. b."
    header2 = "Forensic and criminal records"
    header3 = "(Acta sedrialia et criminalia)"

    cycleCount = 0 
    Const wdPageBreak = 1   
    

    
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row 
        colA = Cells(i, 1).Value 
        colB = Cells(i, 2).Value 
        colC = Cells(i, 3).Value 
        colD = Cells(i, 4).Value 

        
        If cycleCount = 3 Then
            wdDoc.Paragraphs.Last.Range.InsertBreak wdPageBreak 
            cycleCount = 0 
        End If

       
        With wdDoc.Content
            .InsertAfter header1 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 18
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter header2 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = False
                .ParagraphFormat.Alignment = 1
            End With
        End With

                With wdDoc.Content
            .InsertAfter header3 & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 14
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With
        
        wdDoc.Content.InsertAfter vbCrLf    

       
        With wdDoc.Content
            .InsertAfter colB & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter colC & " " & colD & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 26
                .Font.Bold = True
                .ParagraphFormat.Alignment = 2
            End With
        End With

        
        With wdDoc.Content
            .InsertAfter colA & vbCrLf
            With wdDoc.Paragraphs.Last.Range
                .Font.Size = 16
                .Font.Bold = True
                .ParagraphFormat.Alignment = 1
            End With
        End With

        
         If cycleCount < 2 Then
            wdDoc.Content.InsertAfter vbCrLf
        End If

        
        cycleCount = cycleCount + 1
    Next i
End Sub


With the current code, I get the expected result, but it's quite frustrating, so it should be that header1 has Font.size=16 and Font.Bold=True, header2 Font.size=18 and Font.Bold=True, header3 Font.size=16 and Font.Bold=False, etc.

7
  • wdDoc.Paragraphs.Last is the new paragraph after the newline. Don't use newlines to control paragraphs. Word isn't a text editor. Create the Paragraph objects explicitly with Paragraphs.Add instead. Besides, shouldn't you be using a Table instead of adding a new paragraph for every Excel row? Commented Jan 17 at 8:14
  • Thank you, the Add fixed it; I don't want to put it in a table, it's intentional this way. Commented Jan 17 at 9:04
  • It's un-formattable this way. Those aren't rows, they are paragraphs and will move around when users display or print the document. If the window isn't wide enough, they'll wrap. The space between lines and paragraphs isn't the same either, so the rows will be too far part. Characters aren't all the same width so using spaces to separate values is guaranteed to result bad vertical alignment. At the very least you'd need tabs to align the contents properly Commented Jan 17 at 9:09
  • If you really need to use paragraphs, you can use TabStops.Add to add tab stops for the values, only for the paragraphs you want. The doc example sets tab stops for a selection of paragraphs only. wdAlignTabDecimal is probably the best option if you want to display decimal values Commented Jan 17 at 9:11
  • There are no issues with the formatting after I used the Paragraphs.Add, already printed 50 pages and it is perfect, sorry I'm not sure if I understand what are you trying to say with the tabs but the code works perfectly. Commented Jan 17 at 10:16

1 Answer 1

0

Try (untested):

Sub ExportToWordModifiedExcelData()
Dim wdApp As Object, wdDoc As Object, i As Long
Dim colA As String, colB As String, colC As String, colD As String
Const wdAlignParagraphLeft As Long = 0
Const wdAlignParagraphCenter As Long = 1
Const wdAlignParagraphRight As Long = 2
Const header1 As String = "IV. 31. b."
Const header2 As String = "Forensic and criminal records"
Const header3 As String = "(Acta sedrialia et criminalia)"

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp Is Nothing Then Set wdApp = CreateObject("Word.Application")
On Error GoTo 0

With wdApp
  .Visible = True
  .ScreenUpdating = False
  Set wdDoc = .Documents.Add
  For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    colA = Cells(i, 1).Value: colB = Cells(i, 2).Value
    colC = Cells(i, 3).Value: colD = Cells(i, 4).Value
    With wdDoc.Range
      If i > 1 Then
        If (i - 1) Mod 3 = 0 Then .Characters.Last.InsertBefore vbCr & Chr(12)
      End If
      .InsertAfter vbCr & header1
      With .Paragraphs.Last.Range
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Font.Size = 18
        .Font.Bold = True
      End With
      .InsertAfter vbCr & header2
      With .Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = False
      End With
      .InsertAfter vbCr & header3
      With .Paragraphs.Last.Range
        .Font.Size = 14
        .Font.Bold = True
      End With
      .InsertAfter vbCr & colB
      With .Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = True
      End With
      .InsertAfter vbCr & colC & " " & colD
      With .Paragraphs.Last.Range
        .Font.Size = 26
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphRight
      End With
      .InsertAfter vbCr & colA
      With wdDoc.Paragraphs.Last.Range
        .Font.Size = 16
        .Font.Bold = True
        .ParagraphFormat.Alignment = wdAlignParagraphCenter
      End With
    End With
  Next i
  wdDoc.Range.Characters.First.Delete
  .ScreenUpdating = True
End With
End Sub
Sign up to request clarification or add additional context in comments.

2 Comments

Thank you it works like a charm. I was thinking of something like this, but I don't know if it's possible: the contents of a loop should not end up on a separate page. The program should first count how many lines and blank lines are in a loop, then insert that many line breaks, delete them, and insert the content. However, if a line break ends up on the next page, the loop should run on the next page instead. What do you think?
I'm not sure what you mean by "the contents of a loop should not end up on a separate page". Depending on what you're trying to achieve, that might be possible by selectively applying the keep together and/or keep with next paragraph attributes instead of the manual page breaks. I also don't know what you mean about "blank lines in a loop". If you're trying to no output 'colC & " " & colD', for example, where colC & colD are both empty, that should be done by using an If test to suppress the ouput rather than trying to delete the empty lines afterwards.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.