Sub IStoIZ()
' Paul Beverley - Version 01.10.24
' Corrects text to give -iz-, -yz- spellings

promptForConfirmation = False

doExtraWords = False
szExceptions = "analys,reanalys,overanalys,catalys,dialys,"
szExceptions = szExceptions & "electrolys,paralys,hydrolys"

' textColour = wdColorBlue
textColour = 0

highlightColour = wdYellow
highlightColour = 0

analysesColour = 0
analysesColour = wdYellow

bothTCandHighlight = True

nonoStyles = "DisplayQuote,ReferenceList"

closeExceptionsFile = True

doTextBoxes = True

' Address where the IS exceptions file is held

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


ExceptionSFile = "IS_words"

' Start of main program
If doTextBoxes = True Then maxHits = 4 Else maxHits = 3

nonoStyles = "," & nonoStyles & ","
Set mainDoc = ActiveDocument

myTrack = ActiveDocument.TrackRevisions

gottaDoc = False
For Each thisDoc In Application.Documents
  thisName = thisDoc.Name
  If InStr(thisName, ExceptionSFile) > 0 Then
    gottaDoc = True
    closeExceptionsFile = False
    thisDoc.Activate
    Exit For
  End If
Next thisDoc

On Error Resume Next
If gottaDoc = False Then
  Documents.Open mySFile
  If Err.Number = 5174 Then
    MsgBox ("Please open the IS 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 Asc(thisWord) > 32 Then allWords = allWords & thisWord & "!"
Next wd

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

mainDoc.Activate
If promptForConfirmation = True Then
  myResponse = MsgBox("IS to IZ: 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
Selection.HomeKey Unit:=wdStory

For hit = 1 To maxHits
  goes = 0
  If hit = 1 Then
    If ActiveDocument.Endnotes.Count > 0 Then
      Set rng = ActiveDocument.StoryRanges(wdEndnotesStory)
      goes = 1
    End If
  End If
  If hit = 2 Then
    If ActiveDocument.Footnotes.Count > 0 Then
      Set rng = ActiveDocument.StoryRanges(wdFootnotesStory)
      goes = 1
    End If
  End If
  If hit = 3 Then
    Set rng = ActiveDocument.Range
    goes = 1
  End If
  If hit = 4 Then
    goes = ActiveDocument.Shapes.Count
  End If
  If goes > 0 Then
    For myGo = 1 To goes
      someText = True
      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
          End If
          If someText Then
            Set rng = ActiveDocument.Shapes(myGo).TextFrame.TextRange
          Else
            myGo = myGo + 1
          End If
          DoEvents
        Loop Until someText Or myGo > goes
      End If
      theEnd = rng.End
      If someText = True Then
        rng.start = 0
        rng.End = 0
        Do
          With rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = "[iy]s[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, "s", "z")
  
            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 -is- is  near the beginning of the word...
            If rng.start - rng1.start < 4 Then
              ' look for an -is- later in the word
              rng.start = rng1.start + 4
              rng.End = endWord
              With rng.Find
                .ClearFormatting
                .Replacement.ClearFormatting
                .Text = "is[iea]"
                .Wrap = wdFindStop
                .Replacement.Text = ""
                .Forward = True
                .MatchWildcards = True
                .Execute
              End With
              opposite = Replace(rng, "s", "z")
              If rng.Find.Found = False Or rng.start > endWord _
                   Then ChangeIt = False
            End If
          ' Check that it's not in the list of s's
            If InStr(allWords, "!" & LCase(rng1) & "!") > 0 _
                 Then ChangeIt = False
            If InStr(szExceptions, Left(LCase(rng1), 6)) > 0 And _
                 rng1.LanguageID = wdEnglishUK Then ChangeIt = False
            If LCase(rng1.Text) = "analyses" Then _
                 rng1.HighlightColorIndex = analysesColour
            If ChangeIt = True Then
            ' then change it to a z
              If myResponse = vbYes Then rng.Text = opposite
              If rng1.End < rng.End Then rng1.End = rng.End
              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
          Else
            stopNow = True
          End If
          If rng.Text > "" Then
            Set rng = rng1.Duplicate
            rng.Collapse wdCollapseEnd
          End If
          i = theEnd - rng.End
          If (i Mod 100) = 0 And hit = 3 Then StatusBar = _
               "To go: " & Str(i)
          DoEvents
        Loop Until stopNow = True
      End If
      DoEvents
      Debug.Print rng.Text
    Next myGo
  End If
  DoEvents
Next hit

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