Sub WhatChar()
' Paul Beverley - Version 04.03.24
' Show ASCII and unicode and character names

' Decide where to show results
showOnStatusbar = False
showInMessageBox = True

useVoice = False

' To use voice, remove the apostrophe from the following line
' If useVoice = True Then Set speech = New SpVoice

' If the macro gives an error on locked files, make this True
lockedFile = False
lockedFile = True

' If the character is a space, don't show a message box.
justBeepForSpace = False

' If you also want to know what the hex of the ANSI code is:
showHexANSI = True

' If you also want to use this code in FRedit:
prepareFReditCode = True


If showOnStatusbar + showInMessageBox + useVoice = 0 Then _
     Beep: MsgBox "Alter options at the top of the macro code to show results.": _
     Exit Sub

charSelected = (Selection.Start <> Selection.End)
If AscW(Selection) = 32 And justBeepForSpace Then Beep: Exit Sub

CR2 = vbCr & vbCr
If Selection.Start = Selection.End Then Selection.MoveEnd wdCharacter, 1
Set rng = Selection.Range.Duplicate
rng.Collapse wdCollapseStart
rng.MoveEnd , 1

If lockedFile = False Then
  Selection.MoveEnd , 1
  Selection.Range.Revisions.AcceptAll
End If
ansicode = AscW(rng)
nextCharCode = AscW(Right(rng.Text, 1))
uCode = Val(Dialogs(wdDialogInsertSymbol).CharNum)

If Asc(ansicode) = 63 And uCode <> 63 Then
  ansiBit = "ANSI: ???"
Else
  ansiBit = ">>>>>>  ANSI: " & Str(ansicode)
  If showHexANSI = True Then ansiBit = ansiBit & _
       " (hex " & Hex(ansicode) & ")"
End If
hexCode = Replace(Hex(uCode), "FFFF", "")
ucodeBit = vbCr & "Unicode: " & Str(uCode) & "   (hex " & _
      hexCode & ")"
If Selection.Font.Name <> _
     ActiveDocument.Styles(wdStyleNormal).Font.Name Then
  fontBit = vbCr & "Font:   " & Selection.Font.Name
Else
  fontBit = ""
End If
fntSize = Selection.Font.Size
normalSize = ActiveDocument.Styles(wdStyleNormal).Font.Size
fontBit = fontBit & "           Font Size:  " & Str(fntSize)

HexBit = ""
If uCode < 0 Then
  HexBit = vbCr & vbCr & "For FRedit, use Find: <&H" & hexCode & ">"
  If prepareFReditCode = True Then
    Selection.Collapse wdCollapseStart
    startCode = Selection.Start
    Selection.TypeText "<&H" & hexCode & ">|"
    Selection.Start = startCode
    Selection.Cut
  End If
End If

' To correct for Mac codes
Select Case ansicode
  Case 2: ExtraBit = "Foot note end note marker"
  Case 32: ExtraBit = "Ordinary space"
  Case 34: ExtraBit = "Straight double quote"
  Case 39: ExtraBit = "Straight apostrophe"
  Case 40: If Selection.Font.Name = "Symbol" Then ExtraBit = "Funny Symbol font character!"
  Case 45: ExtraBit = "Ordinary hyphen"
  Case 46: ExtraBit = "Full point"
  Case 48: ExtraBit = "Number 0"
  Case 49: ExtraBit = "Number 1"
  Case 50: ExtraBit = "Number 2"
  Case 51: ExtraBit = "Number 3"
  Case 58: ExtraBit = "Colon"
  Case 59: ExtraBit = "Semicolon"
  Case 63: ExtraBit = "Question mark"
  Case 73: ExtraBit = "Uppercase I(eye)"
  Case 76: ExtraBit = "Uppercase L"
  Case 79: ExtraBit = "Uppercase O"
  Case 88: ExtraBit = "Uppercase X"
  Case 96: ExtraBit = "Back tick"
  Case 105: ExtraBit = "Lowercase i (eye)"
  Case 108: ExtraBit = "Lowercase l (el)"
  Case 111: ExtraBit = "Lowercase o"
  Case 120: ExtraBit = "Lowercase x"
  Case 150: ExtraBit = "En dash"
  Case 151: ExtraBit = "Em dash"
  Case 174: ExtraBit = "Registered trademark"
  Case 176: ExtraBit = "Proper degree symbol"

  Case Else: ExtraBit = ""
End Select

' The unicode information will overwrite the ANSI
Select Case uCode
  Case 9: ExtraBit = "Tab character"
  Case 11: ExtraBit = "Manual line break"
  Case 13: ExtraBit = "Just an ordinary paragraph end"
  Case 30: ExtraBit = "Non-breaking hyphen"
  Case 31: ExtraBit = "Optional hyphen"
  Case 124: ExtraBit = "Vertical bar"
  Case 160: ExtraBit = "Non-breaking space"
  Case 176: ExtraBit = "Proper degree symbol"
  Case 178: ExtraBit = "Dodgy squared symbol!"
  Case 179: ExtraBit = "Dodgy cubed symbol!"
  Case 180: ExtraBit = "Dodgy apostrophe!"
  Case 186: ExtraBit = "Masculine ordinal"
  Case 215: ExtraBit = "Proper multiply symbol"
  Case 937: ExtraBit = "Omega"
  Case 956: ExtraBit = "Mu = micro"
  Case 8194: ExtraBit = "En space"
  Case 8195: ExtraBit = "Em space"
  Case 8201: ExtraBit = "Thin space"
  Case 8216: ExtraBit = "Single open curly quote"
  Case 8217: ExtraBit = "Single close curly quote = apostrophe"
  Case 8211: ExtraBit = "En dash"
  Case 8212: ExtraBit = "Em dash"
  Case 8220: ExtraBit = "Double open curly quote"
  Case 8221: ExtraBit = "Double close curly quote"
  Case 8222: ExtraBit = "German open curly quote"
  Case 8226: ExtraBit = "Ordinary bullet"
  Case 8230: ExtraBit = "Ellipsis"
  Case 8242: ExtraBit = "Unicode: single prime"
  Case 8243: ExtraBit = "Unicode: double prime"
  Case 8249: ExtraBit = "French open quote"
  Case 8250: ExtraBit = "French close quote"
  Case 8722: ExtraBit = "Proper minus sign"
End Select

If ExtraBit > "" Then ExtraBit = "      >>>>  " & ExtraBit

If Selection.Font.Superscript = True Then
  ExtraBit = ExtraBit & "      >>>>  superscripted"
End If
If Selection.Font.Subscript = True Then
  ExtraBit = ExtraBit & "      >>>>  subscripted"
End If
If Selection.Font.Italic = True Then
  ExtraBit = ExtraBit & "      >>>>  italic"
End If
If nextCharCode > 688 And nextCharCode < 861 Then
  If useVoice = False Then Beep
  ExtraBit = ExtraBit & "      >>>>  followed by a no-space diacritic" & Str$(nextCharCode)
End If

' This isn't a 'funny' Symbol font, undo the Revisions.AcceptAll
If lockedFile = False And uCode > 0 Then WordBasic.EditUndo

' Show on the status bar
s = "                   "
If showOnStatusbar = True Then _
       StatusBar = s & s & s & s & ansiBit & "    " & ExtraBit _
       & "    " & ucodeBit & "    " & fontBit & HexBit

If useVoice And ExtraBit > "" And charSelected = False Then _
     speech.Speak ExtraBit, SVSFPurgeBeforeSpeak
     
' Display in a message box
If (useVoice And charSelected) Or showInMessageBox _
     Or ExtraBit = "" Or uCode < 0 Then _
     MsgBox ansiBit & ExtraBit & vbCr & ucodeBit & vbCr & fontBit _
    & HexBit, , "WhatChar"
Selection.Collapse wdCollapseStart
End Sub