Method for getting the character code and font name for a symbol

[gmaxey]

In one of the Office Answer forums, I addressed a question about replacing text with a symbol. It seems that in some case you must also change the font name of the text found. I used a User Defined Type in the following code. Just wondering if anyone else has a better idea or method:


Option Explicit
Private Type CCFN
'User defined type for getting symbol character number and font name.
ChrCode As Long
FontName As String
End Type

Sub FRWordWithSymbols()
'Finds/replaces words defined in a table column 1 (headed Text) with symbols defined in column 2 (headed Symbol)
Dim oTbl As Table
Dim oRng As Range
Dim lngIndex As Long
Dim SymData As CCFN
Set oTbl = ActiveDocument.Tables(1)
For lngIndex = 2 To oTbl.Rows.Count
Set oRng = ActiveDocument.Range
'Move range passed the table.
oRng.Start = oTbl.Range.End
With oRng.Find
'Get the defined word/phrase and strip off end of cell mark.
.Text = Left(oTbl.Rows(lngIndex).Cells(1).Range, Len(oTbl.Rows(lngIndex).Cells(1).Range) - 2)
'Get the symbol data (character number and font name)
SymData = fcnCCFN(oTbl.Rows(lngIndex).Cells(2).Range.Characters(1))
While .Execute
'If found, replace found text with character code of the symbol and apply font name.
oRng.Text = Chr(SymData.ChrCode)
oRng.Font.Name = SymData.FontName
oRng.Collapse wdCollapseEnd
Wend
End With
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

Function fcnCCFN(oRng As Range) As CCFN
fcnCCFN.FontName = oRng.Font.Name
oRng.Font.Name = "Normal"
fcnCCFN.ChrCode = AscW(oRng.Text)
oRng.Font.Name = fcnCCFN.FontName
lbl_Exit:
Exit Function
End Function

[Paul_Hossler]

Well, FWIW ...

I did something similar except my From-To table was in another doc to facilitate re-use

Not sure if you need the UDT. I'd think 2 simple variables would do (but that's just my thought after looking at the macro)

Got an example you can post?

[gmaxey]

Paul,

File with examples attached27189