Drawing lines

[Fuzzhead]

I have converted documents from WordPerfect to Word and I am trying to drawn
a line in selected locations. Where ever I have 10 spaces I want to replace
it with no spaces and at that same location draw a line. Below is my macro
but it’s not working. What am I doing wrong?


Dim oFFline As Shape
Dim i
On Error GoTo Endthis
i = Selection.Information(wdVerticalPositionRelativeToPage)

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = ""
Set oFFline = ActiveDocument.Shapes.AddLine(554, i + 12, 524, i + 12)
oFFline.Name = "hline" & idx
idx = idx + 1
.Forward = True
.Wrap = wdFindContinue

Selection.Find.Execute Replace:=wdReplaceAll

Endthis:

 

[Jay Freedman]

Besides the syntax error that there's no End With statement to match
your With statement, you can't stick an unrelated action into the
setup of a .Find object and have it work for a ReplaceAll. You have to
change to doing each replacement individually in a While loop, and put
the action (in this case, drawing the line) into that loop.

Another problem is that you never update the variable i (the vertical
position) for each selection; it gets set once wherever the selection
happens to be at the time the macro starts. That, too, has to go into
the loop so it's reevaluated for each Selection location.

I made a few other small patch-ups in the following...

Dim oFFline As Shape
Dim i As Long
Dim idx As Long
On Error GoTo Endthis

idx = 1
Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
End With

'Selection.Find.Execute Replace:=wdReplaceAll
Do While Selection.Find.Execute(Replace:=wdReplaceOne)
i = Selection.Information(wdVerticalPositionRelativeToPage)
Set oFFline = ActiveDocument.Shapes.AddLine(554, i + 12, 524,
i + 12)
oFFline.Name = "hline" & idx
idx = idx + 1
Loop

Endthis:

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the
newsgroup so all may benefit.

 

[Fuzzhead]

Hi Jay,

Thank you from your help. The macro worked perfectly.

Fuzzhead