Sub IZtoIS()
' Paul Beverley - Version 01.10.24
' Corrects text to give -is-, -ys- spellings

promptForConfirmation = True

nonoStyles = "DisplayQuote,ReferenceList"

' textColour = wdColorLightBlue
textColour = 0

highlightColour = wdYellow
' highlightColour = 0

bothTCandHighlight = False

closeExceptionsFile = True

' Address where the IZ exceptions file is held

' On Windows, it will need to be something like:
' myZFile = "C:\Documents and Settings\Paul\My Documents\IZ_words.docx"
' ...but remove the apostrophe in front of myZFile
 
 
' On a Mac, it will need to be something like:
' myZFile = "/Users/Paul/My Documents/Macro stuff/IZ_words.docx"
' ...but remove the apostrophe in front of myZFile' mySFile = "/Users/Paul/My Documents/Macro stuff/IS_words.docx"



ExceptionZFile = "IZ_words"

' Start of main program
nonoStyles = "," & nonoStyles & ","
Set mainDoc = ActiveDocument

myTrack = ActiveDocument.TrackRevisions
gottaDoc = False
For Each thisDoc In Application.Documents
  thisName = thisDoc.Name
  Debug.Print thisDoc
  If InStr(thisName, ExceptionZFile) > 0 Then
    gottaDoc = True
    closeExceptionsFile = False
    thisDoc.Activate
    Exit For
  End If
Next thisDoc

On Error Resume Next
If gottaDoc = False Then
  Documents.Open myZFile
  If Err.Number = 5174 Then
    MsgBox ("Please open the IZ exceptions file")
    Err.Clear
    Exit Sub
  Else
    On Error GoTo 0
  End If
End If

allWords = "!"
For Each wd In ActiveDocument.Words
  thisWord = Trim(wd)
  If Len(thisWord) > 2 Then
    If Asc(thisWord) > 32 Then allWords = allWords & thisWord & "!"
  End If
Next wd
allWords = LCase(allWords)

If closeExceptionsFile = True And gottaDoc = False Then
  ActiveDocument.Close SaveChanges:=False
End If

mainDoc.Activate
Selection.HomeKey Unit:=wdStory
If promptForConfirmation = True Then
  myResponse = MsgBox("IZ to IS: Edit the text?", vbQuestion + _
       vbYesNoCancel)
Else
  myResponse = vbYes
End If
If myResponse = vbCancel Then Exit Sub
If myTrack = True And myResponse = vbYes Then
  If bothTCandHighlight = False Then
    textColour = 0
    highlightColour = 0
  End If
End If
If myResponse = vbNo Then ActiveDocument.TrackRevisions = False

totChanges = 0
For hit = 1 To 4
  goes = 0
  If hit = 1 Then
    thisMany = ActiveDocument.Endnotes.Count
    If thisMany > 0 Then
      Set rng = ActiveDocument.StoryRanges(wdEndnotesStory)
    End If
  End If
  If hit = 2 Then
    thisMany = ActiveDocument.Footnotes.Count
    If thisMany > 0 Then
      Set rng = ActiveDocument.StoryRanges(wdFootnotesStory)
    End If
  End If
  If hit = 3 Then
    Set rng = ActiveDocument.Content
    Set rng1 = ActiveDocument.Content
    thisMany = 1
    goes = 1
  End If
  goes = 1
  someText = True
  If hit = 4 Then
    thisMany = ActiveDocument.Shapes.Count
    goes = thisMany
  End If
  If goes > 0 And thisMany > 0 Then
    For myGo = 1 To goes
      If hit = 4 Then
        Do
          someText = False
          If ActiveDocument.Shapes(myGo).Type <> 24 And _
               ActiveDocument.Shapes(myGo).Type <> 3 Then
            someText = ActiveDocument.Shapes(myGo).TextFrame.HasText
            If someText Then
              Set rng = ActiveDocument.Shapes(myGo).TextFrame.TextRange
            Else
              myGo = myGo + 1
            End If
          End If
          DoEvents
        Loop Until someText Or myGo > goes
      End If
      theEnd = rng.End
      If someText = True Then
        Do
          With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "[iy]z[iea]"
            .Wrap = wdFindStop
            .Replacement.Text = ""
            .Forward = True
            .MatchWildcards = True
            .MatchWholeWord = False
            .MatchSoundsLike = False
            .Execute
          End With
          If rng.Find.Found = True Then
            fnd = rng
            opposite = Replace(fnd, "z", "s")

            Set rng1 = rng.Duplicate
            rng1.Expand wdWord
            Do While InStr(ChrW(8217) & "' " & ChrW(160), _
                 Right(rng1.Text, 1)) > 0
              rng1.MoveEnd , -1
              DoEvents
            Loop
            startWord = rng1.start
            endWord = rng1.End
 
            ChangeIt = True
            ' But don't make the change if...
            thisStyle = "," & rng.Style & ","
            If InStr(nonoStyles, thisStyle) > 0 Then ChangeIt = False
            If rng.Font.StrikeThrough = True Then ChangeIt = False
  
          ' if it's not in the list of z's
            If InStr(allWords, "!" & LCase(rng1) & "!") = 0 _
                 And ChangeIt = True Then
          ' then definitely change it to an s
              If myResponse = vbYes Then
                rng.Text = opposite
                If ActiveDocument.TrackRevisions = True Then
                  rng1.End = endWord + 3
                Else
                  rng1.End = endWord
                End If
                rng1.End = endWord
              End If
              If highlightColour > 0 Then
                rng1.HighlightColorIndex = highlightColour
              End If
              If textColour > 0 Then
                rng1.Font.Color = textColour
              End If
              totChanges = totChanges + 1
            End If
            stopNow = False
            DoEvents
          Else
            stopNow = True
          End If
          rng.start = rng.End + 2
        Loop Until stopNow = True
      End If
      DoEvents
    Next myGo
  End If
  DoEvents
Next hit

ActiveDocument.TrackRevisions = myTrack
If promptForConfirmation = True Then
  If myResponse = vbYes Then
     MsgBox ("IZ words changed:  " & Str(totChanges) & "  ")
  Else
     MsgBox ("IZ words needing to be changed:  " & Str(totChanges) & "  ")
  End If
End If
End Sub