Sub CharacterSwitch()
' Paul Beverley - Version 08.04.25
' Scripted character switching


specChar = "_"

' On a Mac, you will need something like this:
myList = "/Users/Paul/My Documents/Macro stuff/zzSwitchList.docx"

' On Windows, you will need something like this:
myList = "C:\Documents and Settings\Paul\My Documents\zzSwitchList.docx"
nameStart = InStrRev(myList, "\")
If nameStart = 0 Then nameStart = InStrRev(myList, "/")
listName = Mid(myList, nameStart + 1)
' listName = Replace(listName, ".docx", "")
doaBeep = False
maxChars = 20
doAnErrorBeep = False

Set myDoc = ActiveDocument

gottaList = False
For Each aDoc In Application.Documents
  thisName = aDoc.Name
  If thisName = listName Then
    Set theList = Documents(thisName)
    gottaList = True
    Exit For
  End If
Next aDoc

' Find the zzSwitchList file
If gottaList = False Then
  Documents.Open FileName:=myList
  Set theList = ActiveDocument
  myDoc.Activate
End If

carryOn:
' Create one long string of all the words
myWds = ""
For Each myPara In theList.Paragraphs
  theLine = myPara
  If InStr(theLine, specChar) > 0 Then
    myWds = myWds & "|" & Replace(theLine, Chr(13), "")
  End If
Next myPara
myWds = myWds & "|"
myWds = Replace(myWds, "^=", ChrW(8211))
myWds = Replace(myWds, "^+", ChrW(8212))
myWds = Replace(myWds, "^32", " ")

Selection.Collapse wdCollapseStart
Set rng = Selection.Range.Duplicate
For i = 1 To maxChars
' Select the character
  rng.MoveEnd , 1
  thisChar = Right(rng, 1)
  ' Check in the list of words to see if it's there
  charPos = InStr(myWds, "|" & thisChar & specChar)
  If charPos > 0 Then
  ' If it's in the list, find the replacement text
    myChars = Mid(myWds, charPos + 3)
    newChar = Left(myChars, InStr(myChars, "|") - 1)
    Selection.Start = rng.End - 1
    Selection.MoveEnd , 1
    Selection.Delete
    Selection.TypeText newChar
    rng.Collapse wdCollapseEnd
  ' We've found it, so finish
    Exit Sub
  End If
Next

' If no character match found beep for warning
If doaBeep = True Then Beep

Selection.End = startWas
Exit Sub

ReportIt:
If Err.Number = 5174 Then
  If doAnErrorBeep = True Then Beep
  defaultLoaded = True
  Documents.Open myList
  Resume carryOn
Else
  On Error GoTo 0
  Resume
End If
End Sub