JoeMoe
01-04-2009, 01:12 PM
I'm trying to develop some VBA code that will allow me to draw an arrow the length of a selected range (whether two cells or two hundred cells).
I have already developed code that will draw the arrow as I want it to be drawn, but I want to be able to use this regularly to draw arrows next to varying ranges in different spreadsheets, so I want to be able to select a range and then activate the macro to draw the line. Right now, I have to enter the start/end cell in the code. As an intermediate step, I am planning to use a userform to specify the ranges, but the ultimate goal is to only need to highlight the range and have the macro do the rest.
Any assistance configuring the macro to only need the range to be highlighted would be appreciated.
Here is the current code:
Sub LineDownv2()
Dim X1 As Long
Dim X2 As Long
Dim Y1 As Long
Dim Y2 As Long
Dim Line1 As Shape
Dim mX1 As Long
Dim mY1 As Long
Dim mX2 As Long
Dim mY2 As Long
Dim Line2 As Shape
With Range("B1")
X1 = .Left + .Width / 2
Y1 = .Top
End With
With Range("B8")
X2 = .Left + .Width / 2
Y2 = .Top + .Height - 1.5
End With
With ActiveSheet.Shapes
' Get the return value and create the line.
Set Line1 = .AddLine(X1, Y1, X2, Y2)
Line1.Line.Weight = 1
Line1.Line.BeginArrowheadStyle = msoArrowheadNone
Line1.Line.EndArrowheadStyle = msoArrowheadOpen
Line1.Line.EndArrowheadWidth = msoArrowheadWidthMedium
Line1.Line.EndArrowheadLength = msoArrowheadLengthMedium
Line1.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
With Range("B8")
mX1 = .Left + .Width / 2 - 4
mX2 = .Left + .Width / 2 + 4
mY1 = .Top + .Height - 1
mY2 = .Top + .Height - 1
End With
With ActiveSheet.Shapes
Set Line2 = .AddLine(mX1, mY1, mX2, mY2)
Line2.Line.Weight = 1
Line2.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
End Sub
Also, if someone knows how to easily group the two objects that are created (arrow + line at bottom) that would also be helpful.
Thanks in advance.
I have already developed code that will draw the arrow as I want it to be drawn, but I want to be able to use this regularly to draw arrows next to varying ranges in different spreadsheets, so I want to be able to select a range and then activate the macro to draw the line. Right now, I have to enter the start/end cell in the code. As an intermediate step, I am planning to use a userform to specify the ranges, but the ultimate goal is to only need to highlight the range and have the macro do the rest.
Any assistance configuring the macro to only need the range to be highlighted would be appreciated.
Here is the current code:
Sub LineDownv2()
Dim X1 As Long
Dim X2 As Long
Dim Y1 As Long
Dim Y2 As Long
Dim Line1 As Shape
Dim mX1 As Long
Dim mY1 As Long
Dim mX2 As Long
Dim mY2 As Long
Dim Line2 As Shape
With Range("B1")
X1 = .Left + .Width / 2
Y1 = .Top
End With
With Range("B8")
X2 = .Left + .Width / 2
Y2 = .Top + .Height - 1.5
End With
With ActiveSheet.Shapes
' Get the return value and create the line.
Set Line1 = .AddLine(X1, Y1, X2, Y2)
Line1.Line.Weight = 1
Line1.Line.BeginArrowheadStyle = msoArrowheadNone
Line1.Line.EndArrowheadStyle = msoArrowheadOpen
Line1.Line.EndArrowheadWidth = msoArrowheadWidthMedium
Line1.Line.EndArrowheadLength = msoArrowheadLengthMedium
Line1.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
With Range("B8")
mX1 = .Left + .Width / 2 - 4
mX2 = .Left + .Width / 2 + 4
mY1 = .Top + .Height - 1
mY2 = .Top + .Height - 1
End With
With ActiveSheet.Shapes
Set Line2 = .AddLine(mX1, mY1, mX2, mY2)
Line2.Line.Weight = 1
Line2.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
End Sub
Also, if someone knows how to easily group the two objects that are created (arrow + line at bottom) that would also be helpful.
Thanks in advance.