Wednesday, December 24, 2008

Convert Symbols to Entities using Word VBA

Word VBA Symbols to Entities Conversion Program



Symbols when converted to Text (Save as Text) seldom retain the original shape. It has been a practice to convert these symbols to entities (mostly the symbol name prefixed with an ampersand and followed by a semi colon), for example, α † etc



The following code expects a tab separated text file with symbol’s character code and its corresponding entity representation. For example



176 & degree;


945 & alpha;



To know about the corresponding character code for a symbol, you can use Alt + Symbol Key. For example Alt + 0151 will give an emdash etc



Or you can check from Insert -- > Symbol

Word Insert Symbol Dialog





We read the text file using FileSystemObject’s OpenTextFile (Refer )



Set oFil = oFS.OpenTextFile("c:\testasc.txt")



and uses the Split Function to convert each line to an array of two elements and iterate through the document



Sub Convert_Symbols2Entities()



Dim MyString


Dim arFindReplace


Dim oFS As Object



On Error GoTo Err_Found



Selection.HomeKey wdStory, wdMove



Set oFS = CreateObject("Scripting.FileSystemObject")



Set oFil = oFS.OpenTextFile("c:\testasc.txt")



Do Until oFil.AtEndOfStream ' Loop until end of file.



MyString = oFil.ReadLine



' Report if the Input is not Tab Separated


If InStr(1, MyString, Chr(9)) = 0 Then


Open ActiveDocument.Path & "\" & "SymbolsError.txt" For Append As 3


Print #3, MyString & " not replaced"


Close #3


GoTo TakeNext


End If



' Split the Input to Find & Replace Text


arFindReplace = Split(MyString, Chr(9))



' Report if ASCII Value is not valid


If Val(arFindReplace(0)) = 0) Then '' Then


Open ActiveDocument.Path & "\" & "SymbolsError.txt" For Append As 3


Print #3, MyString & " ASCII Value not valid"


Close #3


GoTo TakeNext


End If



Selection.Find.ClearFormatting



Selection.HomeKey wdStory, wdMove


With Selection.Find


.Text = ChrW(Val(arFindReplace(0)))


.Replacement.Text = arFindReplace(1)


End With


Selection.Find.Execute Replace:=wdReplaceAll



TakeNext:


Loop



LastCommands:


Close #1 ' Close file.


If Not oFS Is Nothing Then Set oFS = Nothing



Exit Sub


Err_Found:


' ----------------------------


' Error Handling


' ----------------------------


If Err <> 0 Then


Debug.Assert Err.Number <> 0


MsgBox Err.Number & " " & Err.Description & " has occurred", vbCritical, "ASCII Convert"


Err.Clear


GoTo LastCommands


End If



The code uses ChrW function, which returns a String containing the Unicode character except on platforms where Unicode is not supported




3 comments:

  1. If you want to make it easy to support UniCode in Visual Basic then take a look at the UniToolbox control suite which replaces all the common VB controls with UniCode aware versions:

    If you want to make it easy to support UniCode in Visual Basic then take a look at the UniToolbox control suite which replaces all the common VB controls with UniCode aware versions:

    http://www.iconico.com/UniToolbox

    ReplyDelete
  2. Anonymous12:24 PM

    Hi

    I am following most of the threads in this blog and I find it indeed useful, but I am truely a beginner in VB. I need it for designing my ppt lessons for my students. I will be grateful if you could tell me what is wrong with this code below or refer me to whoever could help me with this. Your comments are very much appreciated.

    Private Sub strName_Click()

    End Sub

    Private Sub strFName_Change()
    On Error Resume Next
    Dim strFName As String
    Dim strLName As String
    Dim strName As Label
    strFName = "John"
    strLName = "Smith"
    If (strFName = "John") Then
    strName.Caption = "John"
    Else
    MsgBox ("Incorrect data entry")
    If (strLName = "Smith") Then
    strName.Caption = "Smith"
    Else
    MsgBox ("Incorrect data entry")
    If (strFName = "John" & strLName = "Smith") Then
    strName.Caption = "John Smith"
    Else
    MsgBox ("Incorrect data entry!"), vbExclamation
    End If
    End If
    End If

    End Sub

    Private Sub strLName_Change()
    On Error Resume Next
    Dim strFName As String
    Dim strLName As String
    Dim strName As Label
    strFName = "John"
    strLName = "Smith"
    If (strFName = "John") Then
    strName.Caption = "John"
    Else
    MsgBox ("Incorrect data entry")
    If (strLName = "Smith") Then
    strName.Caption = "Smith"
    Else
    MsgBox ("Incorrect data entry")
    If (strFName = "John" & strLName = "Smith") Then
    strName.Caption = "John Smith"
    Else
    MsgBox ("Incorrect data entry!"), vbExclamation
    End If
    End If
    End If
    End Sub

    ReplyDelete
  3. Anonymous12:18 AM

    Are you trying to validate some userform. Your code has some hardcoded stuff, should it be made dynamic

    ReplyDelete

StumbleUpon
Share on Facebook
Related Posts Plugin for WordPress, Blogger...

Visual Basic for Applications (VBA) Forum (recent threads)

CodeKeep VBA Feed

Visual Studio Tools for Office Forum (recent threads)

Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.

Office Business Applications (OBA) Team Blog

MSDN Code Gallery Published Resources For Tag VSTO

microsoft.public.vsnet.vstools.office Google Group