Determing line object start and end corridinates

[gmaxey]

There is a problem line drawing object drawn with Word2007. When these objects are drawn using the UI, the style attribute is disabled.

Lines drawn in Word2003 and pasted into Word2007 can be fully formatted (style enabled) in the UI. Also lines created in Word2007 using VBA can be fully formatted in the UI.

I have put together some code intended to duplicate and replace a line drawn using the UI as a line that can be fully formatted. I draw the line in the document with the UI, select it, and then run this code:

Sub DuplicateAndReplaceLine()
Dim oShp As Word.Shape
Dim oShpNew As Word.Shape
Dim i, j, k, l As Long
Set oShp = Selection.ShapeRange(1)
i = oShp.Left
j = oShp.Top
k = oShp.Height
l = oShp.Width
oShp.Delete
Set oShpNew = ActiveDocument.Shapes.AddLine(i, j, i + 72, j)
With oShpNew
.Left = i
.Top = j
.Width = l
.Height = k
With .Line
.Style = msoLineSingle
.Weight = 0.75
End With
End With
End Sub


It works provided the line is vertical, horizontal or slopes left to
right down the page.

The problem is lines that slope rigth to left down the page appear as a mirror image of the original line and slope left to right down the page.

I could easily fix this using flip, but I can't figure out how to tell (at runtime) if the line will need flipping.

Does anyone have any ideas how to determine the direction of slope for a line drawing or the corridinates of the line start and end points.

Thanks.

[gmaxey]

With a little help from Tony Jollans I found a solution. It doesn't give the slope, but it does provide a means of replicating the line:

Sub DuplicateAndReplaceLine()
'Declare variables
Dim oShp As Word.Shape
Dim bHFlip As Boolean
Dim bVFlip As Boolean
Dim oShpNew As Word.Shape
Dim i As Long, j As Long, k As Long, l As Long
Dim lngBAL As Long, lngBAS As Long, lngBAW As Long
Dim lngEAL As Long, lngEAS As Long, lngEAW As Long
Dim lngStyle As Long
Dim pWeight As String
'Get the cooridates and attributes of the selected line
Set oShp = Selection.ShapeRange(1)
i = oShp.Left
j = oShp.Top
k = oShp.Height
l = oShp.Width
bHFlip = oShp.HorizontalFlip
bVFlip = oShp.VerticalFlip
With oShp.Line
lngStyle = .Style
pWeight = .Weight
lngBAL = .BeginArrowheadLength
lngBAS = .BeginArrowheadStyle
lngBAW = .BeginArrowheadWidth
lngEAL = .EndArrowheadLength
lngEAS = .EndArrowheadStyle
lngEAW = .EndArrowheadWidth
End With
'Delete the line
oShp.Delete
'Recreate the line as a fully formattable VBA inserted line
Set oShpNew = ActiveDocument.Shapes.AddLine(i, j, i + 72, j)
With oShpNew
.Left = i
.Top = j
.Width = l
.Height = k
If .HorizontalFlip <> bHFlip Then .Flip (msoFlipHorizontal)
If .VerticalFlip <> bVFlip Then .Flip (msoFlipVertical)
With .Line
.Style = lngStyle
.Weight = pWeight
.BeginArrowheadLength = lngBAL
.BeginArrowheadStyle = lngBAS
.BeginArrowheadWidth = lngBAW
.EndArrowheadLength = lngEAL
.EndArrowheadStyle = lngEAS
.EndArrowheadWidth = lngEAW
End With
End With
End Sub

[macropod]

Hi Greg,

Why do things the hard way?
Sub DuplicateAndReplaceLine()
Dim oShp As Object, oShpNew As Shape
Dim ptArry(1 To 2, 1 To 2) As Single, vPts As Variant
Set oShp = Selection.ShapeRange(1)
For i = 1 To oShp.Nodes.Count
With oShp.Nodes
vPts = .Item(i).Points
ptArry(i, 1) = vPts(1, 1)
ptArry(i, 2) = vPts(1, 2)
End With
Next
oShp.Delete
Set oShpNew = ActiveDocument.Shapes.AddLine(ptArry(1, 1), ptArry(1, 2), ptArry(2, 1), ptArry(2, 2))
oShpNew.Select
End Sub

[gmaxey]

MacroPod,

I had tried going that route previously but hit the same problem that I have with your code. If I draw and select a line then run your code I get a run time error on this line:

For i = 1 To oShp.Nodes.Count

"This member can only be accessed for a freeform object."

When I run that code with a freeform squiggly line I get this error:

Subscript out of range.

I am assuming that you tested before posting so I must be missing something. Thanks.

[macropod]

Hi Greg,

When I tested your first set of code (Word 2000), I found there was a lack of control over the line's orientation. The code I posted fixed that, but I didn't test it with Word 2007 which, as you found, chokes on it - even with a line pasted from a Word 2000 document. So much for backwards compatability. Here's a variation on the theme, which does work in Word 2007 for a Word 2000 line (but changes the line to a polyline), but still doesn't work for a line inserted using Word 2007. Go figure.
Sub DuplicateAndReplaceLine()
Dim oShp As Object, oShpNew As Shape, i As Integer
Dim ptArry(1 To 2, 1 To 2) As Single, vPts As Variant
Set oShp = Selection.ShapeRange(1)
For i = 1 To oShp.Nodes.Count
With oShp.Nodes
vPts = .Item(i).Points
ptArry(i, 1) = vPts(1, 1)
ptArry(i, 2) = vPts(1, 2)
End With
Next
oShp.Delete
Set oShpNew = ActiveDocument.Shapes.AddPolyline(ptArry)
oShpNew.Select
End Sub

[gmaxey]

MacroPod,

Thanks for the clarification. Now I know the problem is with Word2007 and not with what I had tried to do.

[fumei]

"Now I know the problem is with Word2007 and not with what I had tried to do."

:funnyashe

Yeesssss, it is a odd thing about 2007....