Method for getting the character code and font name for a symbol
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:
Code:
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
