Microsoft Office Forums - View Single Post - Macro that formats (true title) case by Heading style

gmaxey · 09-19-2015, 07:41 PM

Marrick,

I love it when I get credit for Graham's work

The reason for your continuous loop is because you can't collapse the selection to the right side of the end of document mark. That means if the last paragraph has Heading 1 applied you are constantly processing the last paragraph (end of document mark).

Here is my version:

Code:

Sub Greg_Apply_True_Title_Case_by_Style()
Dim oPar As Paragraph
Dim oRng As Range
Dim arrFind() As String
Dim lngIndex As Long
  arrFind = Split("A,An,And,As,At,But,By,For,If,In,Of,On,Or,The,To,With", ",")
  For Each oPar In ActiveDocument.Paragraphs
    If oPar.Style = "Heading 1" Then
      Set oRng = oPar.Range
      oRng.Case = wdTitleWord
      With oRng.Find
        For lngIndex = 0 To UBound(arrFind)
          .Text = arrFind(lngIndex)
          .Replacement.Text = LCase(.Text)
          .MatchWholeWord = True
          .Execute MatchCase:=True, Replace:=wdReplaceAll
        Next lngIndex
      End With
    End If
  Next oPar
End Sub