WD2002: Symbol Characters Are Changed to Box Characters

Sub ConvertSymbol()

   Dim dlg As Object
   Dim NoFC As Integer
   Dim SCP As Integer
   Dim StartRange As Range
   Dim UniCodeNum As Integer

   ' Temporarily disable Screen Updating
   Application.ScreenUpdating = False

   ' Temporarily disable Smart Cut & Paste
   If Options.SmartCutPaste = True Then
      SCP = 1
      Options.SmartCutPaste = False
   End If

   ' Temporarily display field text
   If ActiveWindow.View.ShowFieldCodes = False Then
      NoFC = 1
      ActiveWindow.View.ShowFieldCodes = True
   End If

   ' Set StartRange variable to current selection's range
   Set StartRange = Selection.Range
   Selection.Collapse

   ' Select first, then each next character in user-defined selection
   Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
   While Selection.End <= StartRange.End And _
      ActiveDocument.Content.End > Selection.End

      ' If the character is a space, then move to next character
      Set dlg = Dialogs(wdDialogInsertSymbol)
      UniCodeNum = dlg.charnum

      If UniCodeNum = 32 Then
         Selection.Collapse
         Selection.MoveRight unit:=wdCharacter, Extend:=wdMove
         Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
      End If

      ' Loop, converting symbol Unicode characters to ASCII characters
      Set dlg = Dialogs(wdDialogInsertSymbol)
      UniCodeNum = dlg.charnum

      While UniCodeNum < 0 And Selection.End <= StartRange.End _
         And ActiveDocument.Content.End > Selection.End
            Selection.Delete
            Selection.InsertAfter (ChrW(UniCodeNum + 4096))
            Selection.Collapse (wdCollapseEnd)
            Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
            Set dlg = Dialogs(wdDialogInsertSymbol)
            UniCodeNum = dlg.charnum
      Wend

      Selection.Collapse (wdCollapseEnd)
      Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend
   Wend

   ' Reset Word document settings
   If SCP = 1 Then Options.SmartCutPaste = True
   If NoFC = 1 Then ActiveWindow.View.ShowFieldCodes = False
      Selection.Collapse (wdCollapseStart)
      Selection.MoveLeft unit:=wdCharacter
      Application.ScreenUpdating = True

End Sub