Add formatted entries from a table in document to the autocorrect library

I’m attempting to add formatted entries from a table in MSWord 2016 document to the autocorrect library (which is stored in normal.dotx as usual for formatted entries).

In the document I have a table containing two columns, the left column has the short text and the right column has the formatted long text for the autocorrect entries.

I have a working macro for storing unformatted text using the line AutoCorrect.Entries.Add Name:=ShortText, Value:=LongText.
I’m trying to modify it to use the AutoCorrect.Entries.AddRichText ShortText, longtext function which should then pick up the font and italics properties in the table.

I tried two methods.

FIRST - testAddRichText1

Here’s the code (removed some of the cosmetics)

Sub testAddRichText1()
    Set oDoc = ActiveDocument
    For i = 1 To oDoc.Tables(2).Rows.Count
        If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
            ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
            ShortText = Left(ShortText, Len(ShortText) - 2) 'remove the trailing CR and LF
            longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2)
            StatusBar = "Adding " & ShortText & " = " & longtext.Text
            AutoCorrect.Entries.AddRichText ShortText, longtext
        End If
    Next i
    MsgBox "done"
End Sub

Using this code, there are a number of unprintable characters at the end of the text extracted from the cell, mostly Chr(13)’s. I tried running a cleaner over the string to remove all non-printable characters, but there is something there that just won’t go away and causes a black box at the end of the corrected text when the autocorrect is used. I assume it’s some sort of secret word code that is in the table cell. Attempting to print the ASC value of it returns 13, but deleting it has no effect (just removes characters before the blackbox symbol).

SECOND testAddRichText2

I tried adding italics to my text string in my working model, and then using it with the AddRichText method. AddRichText expects a range and I haven’t been able to convert the text string into a range.

Here is that code

Sub testAddRichText2()
    Set oDoc = ActiveDocument
    Dim LongTextrng As Range
    For i = 1 To oDoc.Tables(2).Rows.Count
        If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
            ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
            ShortText = Left(ShortText, Len(ShortText) - 2)
            longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2).Range
            longtext = Left(longtext, Len(longtext) - 2)
            LongTextrng.Text = longtext 'Fails
            LongTextrng.Italic = True
            StatusBar = "Adding " & ShortText & " = " & longtextrng.Text
                AutoCorrect.Entries.Add Name:=ShortText, Value:=LongTextrng
        End If
    Next i
    MsgBox "done"
End Sub

Solution

Your first example, testAddRichText1, is almost correct. It fails because although you have recognised the need to remove the trailing characters from ShortText you haven't done the same for longText.

To shorten a range you move the end of the range using the MoveEnd method. In this instance you need to move the end of the range back one character to remove the end of cell marker.

In your second example, testAddRichText2, the code fails because you have not assigned the range to the variable, LongTextrng, correctly. When assigning a value to an object variable you need to use the Set command, like this:

Set objVar = object

This did not fail in your first attempt because LongText has not been declared and is therefore assumed to be a Variant.

The code below will work for you:

Sub AddRichTextAutoCorrectEntries()
    Dim LongText                    As Range
    Dim oRow                        As Row
    Dim ShortText                   As String

    For Each oRow In ActiveDocument.Tables(2).Rows
        If oRow.Cells(1).Range.Characters.Count > 1 Then
            ShortText = oRow.Cells(1).Range.Text
            ShortText = Left(ShortText, Len(ShortText) - 2)
            'assign the range to the variable
            Set LongText = oRow.Cells(2).Range
            'move the end of the range back by 1 character
            LongText.MoveEnd wdCharacter, -1
            StatusBar = "Adding " & ShortText & " = " & LongText.Text
            AutoCorrect.Entries.AddRichText Name:=ShortText, Range:=LongText
        End If
    Next oRow
End Sub