Given the example document, I would use
Code:
Sub Macro1()
Dim oPara As Paragraph
Dim oRng As Range
For Each oPara In ActiveDocument.Paragraphs
Set oRng = oPara.Range
oRng.End = oRng.End - 1
oRng.MoveStartUntil Chr(151)
oRng.Start = oRng.Start + 1
oRng.Case = wdTitleWord
Next oPara
Set oPara = Nothing
Set oRng = Nothing
End Sub
or using Find
Code:
Sub Macro2()
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(Chr(151))
oRng.End = oRng.Paragraphs(1).Range.End - 1
oRng.Case = wdTitleWord
oRng.Collapse 0
Loop
End With
Set oRng = Nothing
End Sub