Shape size

L

LEU

I have the following macro that draws a horizontal line in my document
relative to where the cursor is in the document. I need to go back into all
the documents and make my line shorter. Is there a way to write a macro to go
through my document and find each line and make it shorter? I need to change
the 499 to 524.

Sub hLine1()
Dim oFFline As Shape
Dim i
On Error GoTo Endthis
i = Selection.Information(wdVerticalPositionRelativeToPage)
Set oFFline = ActiveDocument.Shapes.AddLine(554, i + 12, 499, i + 12)
oFFline.Name = "hline" & idx
idx = idx + 1
Endthis:
End Sub
 
J

Jay Freedman

Sub ShortenHline()
Dim oFFline As Shape
For Each oFFline In ActiveDocument.Shapes
With oFFline
If (.Type = msoLine) And _
(LCase(Left(.Name, 5)) = "hline") Then
.Width = .Width - 25
.Left = .Left + 25
End If
End With
Next
End Sub

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

LEU

Hi Jay,

Thank you for answering . I plugged in your macro and ran it. It went
through the first 1/2 of the document and corrected the lines and then it
stopped. Any ideas on why that would happen? Is there a way to verify that
the lines not changed are named 'hline'?
 
J

Jay Freedman

Well, now that the macro has already changed some but not all of the
lines, you have two conditions to watch out for: you want to change
the ones that have not yet been changed, but you don't want to change
again the ones that have already been done and make them too short.

The first condition can be handled by not checking the name -- maybe
the unchanged lines have some other name, or no name at all. The
second condition involves checking the line's width and reducing it
only if it's still long.

This variation of the macro should take care of both conditions:

Sub ShortenHline()
Dim oFFline As Shape
For Each oFFline In ActiveDocument.Shapes
With oFFline
If (.Type = msoLine) And _
(.Width > 50) Then
.Width = .Width - 25
.Left = .Left + 25
End If
End With
Next
End Sub

If running this version of the macro still doesn't change all the
remaining lines, try this. Change the macro to

Sub ShortenHline()
Dim oFFline As Shape
For Each oFFline In ActiveDocument.Shapes
With oFFline
If (.Type = msoLine) And _
(.Width > 50) Then
.Width = .Width - 25
.Left = .Left + 25
Else
Debug.Print "Page " & _
.Anchor.Information(wdActiveEndAdjustedPageNumber) _
& " Name = " & .Name & " Left = " & _
.Left & " Width = " & .Width & " Top = " _
& .Top & " Type = " & .Type
End If
End With
Next
End Sub

Open the Immediate window in the VBA editor (Ctrl+G), then put the
cursor in the macro and run it with F5. When it finishes, look through
the list in the Immediate window of all the lines that it didn't
change. It should give you enough information to identify each item in
the list with a specific line on a specific page, and to know why it
wasn't changed. (The constant msoLine has a value of 9, which is what
you should see for each line.)

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

LEU

Hi Jay,

The following macro did the trick. Thanks again for all your help.

Sub ShortenHline()
Dim oFFline As Shape
For Each oFFline In ActiveDocument.Shapes
With oFFline
If (.Type = msoLine) And _
(.Width > 50) Then
..Width = .Width - 25
..Left = .Left + 25
End If
End With
Next
End Sub

LEU
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Draw Table 4
Drawing lines 2
More efficient macro 5
Textbox help 2
Finding shapes 12
Variable question 2
Deleting shapes 5
Keep First Letters, with exceptions 0

Top