Macro to find a marker, format the line, delete the marker

[Marcus O. M. Grabe]

Hi all,

My Situation:

I regularly get plain text documents (*.txt), that are completely
unformatted. Now a macro should do the following for the entire
document:

1. Find all lines starting with " Titel: " (5 x Space, "Titel", 1
x Space)
2. Format the entire line
3. Delete the marke " Titel: " at the beginning of the line.

I managed to write the following code (that even works ;-) :

Sub HighlightTitel()

Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "Titel: "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 16
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = " Titel: "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.HomeKey Unit:=wdStory

End Sub

This seems to be much more code than actually needed, i.e. I am sure
that several lines are redundant.

So I would appreciate any hint for improvement. I am for example very
interessted to get rid of the Selection Object.

Thanks a lot,

Marcus.

Danke, Marcus.

 

[Helmut Weber]

Hi Marcus,

if you are talking about paragraphs, not lines, then:

Sub test01()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = " Titel: "
.Replacement.Text = ""
While .Execute(Replace:=wdReplaceOne)
With rDcm.Paragraphs(1).Range
.Font.Name = "Tahoma"
.Font.Size = 16
End With
Wend
End With
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Marcus O. M. Grabe]

Hi Marcus,

if you are talking about paragraphs, not lines, then:

Sub test01()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = " Titel: "
.Replacement.Text = ""
While .Execute(Replace:=wdReplaceOne)
With rDcm.Paragraphs(1).Range
.Font.Name = "Tahoma"
.Font.Size = 16
End With
Wend
End With
End Sub

Hi Helmut,

works great. And it's so simple.

Thanks a lot, Marcus.