u/caerulium

[WORD] Range.FormattedText won't preserve font in last line of text
▲ 4 r/vba+1 crossposts

[WORD] Range.FormattedText won't preserve font in last line of text

I'm trying to tweak a macro I use to extract all comments from a Word document and place them in a table in a second Word document, which is forcing me to learn VBA/about how Macros work on the fly. My original issue was that the extracted comments weren't preserving formatting. As far as I understood, the issue was range.Text, so I replaced that with range.FormattedText, which sort of works – at least, now any coloured text, text effects (bold, italics etc.) and bullet points get carried over. But the font, text size and paragraph indent of the last line/paragraph (or, if the comment is only one line, the whole comment text) is always overridden by the Normal Style of the new document. This is messing up bullet points/numbered lists by preserving all points except the last one if the comment ends with a list. Here is an example screencap of the original comments next to the extracted comments so you can see exactly what's happening to them.

I can't figure out what causes this so I'm stumped on how to fix it 🤔. Any guidance would be much appreciated, especially if anyone has time to explain the cause, because I want to keep learning! Here is the code as I've edited it so far:

  Public Sub ExtractCommentsToNewDoc()  
'The macro creates a new document
    'and extracts all comments from the active document
    'incl. metadata
    
    'Minor adjustments are made to the styles used
    'You may need to change the style settings and table layout to fit your needs
    '=========================

    Dim oDoc As Document
    Dim oNewDoc As Document
    Dim oTable As Table
    Dim nCount As Long
    Dim n As Long
    Dim Title As String
    
    Title = "Extract All Comments to New Document"
    Set oDoc = ActiveDocument
    nCount = ActiveDocument.Comments.Count
    
    If nCount = 0 Then
        MsgBox "The active document contains no comments.", vbOKOnly, Title
        GoTo ExitHere
    Else
        'Stop if user does not click Yes
        If MsgBox("Do  you want to extract all comments to a new document?", _
                vbYesNo + vbQuestion, Title) <> vbYes Then
            GoTo ExitHere
        End If
    End If
        
    Application.ScreenUpdating = False
    'Create a new document for the comments, base on Normal.dotm
    Set oNewDoc = Documents.Add
    'Set to landscape
    oNewDoc.PageSetup.Orientation = wdOrientLandscape
    'Insert a 2-column table for the comments
    With oNewDoc
        .Content = ""
        Set oTable = .Tables.Add _
            (Range:=Selection.Range, _
            NumRows:=nCount + 1, _
            NumColumns:=2)
    End With
            
    'Adjust the Normal style and Header style
    With oNewDoc.Styles(wdStyleNormal)
        .Font.Name = "EB Garamond"
        .Font.Size = 12
        .ParagraphFormat.LeftIndent = 0
        .ParagraphFormat.SpaceAfter = 6
    End With
    
    'Format the table appropriately
    With oTable
        .Range.Style = wdStyleNormal
        .AllowAutoFit = False
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        .Columns.PreferredWidthType = wdPreferredWidthPercent
        .Columns(1).PreferredWidth = 40
        .Columns(2).PreferredWidth = 60
        .Rows(1).HeadingFormat = True
    End With

    'Insert table headings
    With oTable.Rows(1)
        .Range.Font.Bold = True
        .Cells(1).Range.Text = "Manuscript text"
        .Cells(2).Range.Text = "Comment"
    End With
    
    'Get info from each comment from oDoc and insert in table
    For n = 1 To nCount
        With oTable.Rows(n + 1)
            'The text marked by the comment
            .Cells(1).Range.Text = oDoc.Comments(n).Scope
            'The comment itself
            .Cells(2).Range.FormattedText = oDoc.Comments(n).Range.FormattedText
        End With
    Next n
    
    Application.ScreenUpdating = True
    Application.ScreenRefresh
        
    oNewDoc.Activate
    MsgBox nCount & " comments found. Finished creating comments document.", vbOKOnly, Title

ExitHere:
    Set oDoc = Nothing
    Set oNewDoc = Nothing
    Set oTable = Nothing

End Sub

^(Note:) ^(Original code was from Lene Fredborg of) ^(https://www.thedoctools.com)^(, who has since retired and taken down the page where I first got this macro from. I swear I kept a copy of the original but I can't find it right now, but I'm hopeful that won't be a problem. For reference, I've only changed the number of columns in the generated table and removed the lines that added a header to the generated document, neither of which have caused me any problems in testing.)

u/caerulium — 6 days ago