Macro for inserting a line?

[Jason]

I am trying to find info on making a macro to insert a line (.75pt, .5 inch
long, and some other atributes that I think I can figure out) into a word
file.

Can this be done? Any help appreciated!
Jason

 

[Jason]

This is what I have been able to put together, but it doesn't work

Sub Workingslot()
'
' Workingslot Macro
' Workingslot
'
Dim sh As Shape
Set sh = ActiveDocument.Shapes.AddLine
With sh
.Line.Weight = 0.75
.Line.Width = 36#
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)

End With

End Sub

 

[Helmut Weber]

Hi Jason,
this is one from my toolbox.
It inserts a line, which does not move with the text,
at the cursor position. The line properties are up to you.
Public Sub Test05()
Dim aLine As Object
Dim apos As Integer
' wdVerticalPositionRelativeToPage = 6
' wdVerticalPositionRelativeToTextBoundary = 8
' wdRelativeHorizontalPositionPage = 1
' wdRelativeVerticalPositionPage = 1
apos = Int(Selection.Information(6))
Set aLine = ActiveDocument.Shapes.AddLine(70, apos, 280, apos)
aLine.Select
With Selection.ShapeRange
.LockAnchor = False
.RelativeHorizontalPosition = 1
.RelativeVerticalPosition = 1
.Left = CentimetersToPoints(2.54)
.Top = apos
End With
With aLine.Line
.ForeColor.RGB = RGB(255, 0, 0)
.DashStyle = msoLineDash
End With
End Sub
---
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Jason]

Danke sehr Helmet! I am using this code inside a table and when I use your
it places the line 2 inches below and one inch to the right. My final code
uses:
Selection.ShapeRange.IncrementTop -135 AND .Left = 2
to correct the problem. Any better/cleaner solutions?

Public Sub Test05()
Dim aLine As Object
Dim apos As Integer
' wdVerticalPositionRelativeToPage = 6
' wdVerticalPositionRelativeToTextBoundary = 8
' wdRelativeHorizontalPositionPage = 1
' wdRelativeVerticalPositionPage = 1
apos = Int(Selection.Information(6))
Set aLine = ActiveDocument.Shapes.AddLine(12, apos, 50, apos)
aLine.Select
With Selection.ShapeRange
.LockAnchor = True
.RelativeHorizontalPosition = 1
.RelativeVerticalPosition = 1
.Left = 2
.Top = apos
End With
With aLine.Line
.ForeColor.RGB = RGB(0, 0, 0)
.DashStyle = msoLineSingle
.EndArrowheadLength = msoArrowheadShort
.EndArrowheadWidth = msoArrowheadNarrow
.EndArrowheadStyle = msoArrowheadOval

End With
Selection.ShapeRange.IncrementTop -135

End Sub

THANKS!

 

[Jason]

ok... last problem hopefully. The line will not "move with text"... tried
searching for answers and tried numerous solutions but no avail. Is it that
this is in a table?


Sub InsertBulletLineLRG()

Dim aLine As Object
Dim apos As Integer
' wdVerticalPositionRelativeToPage = 6
' wdVerticalPositionRelativeToTextBoundary = 8
' wdRelativeHorizontalPositionPage = 1
' wdRelativeVerticalPositionPage = 1
apos = Int(Selection.Information(6))
Set aLine = ActiveDocument.Shapes.AddLine(12, apos, 102, apos)
aLine.Select
With Selection.ShapeRange
.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = _
wdRelativeVerticalPositionPage
.LockAnchor = False
.WrapFormat.Side = wdWrapSquare
.Left = 2
.Top = apos
End With
With aLine.Line
.ForeColor.RGB = RGB(0, 0, 0)
.DashStyle = msoLineSingle
.EndArrowheadLength = msoArrowheadShort
.EndArrowheadWidth = msoArrowheadNarrow
.EndArrowheadStyle = msoArrowheadOval

End With
Selection.ShapeRange.IncrementTop -136

End Sub

 

[Helmut Weber]

Hi Jason,
just to let you know, that I am reading.
I don't know, sorry. Word crashes, VBA-help
shows nothing but a gray window.
A glorious mess.
---
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Jason]

No Problem thanks for help and attention! To get by I made another button
by recording the manual key steps.