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