Drawing object references

[JASon]

What I'm trying to do is have a macro that draws an arrow
from one cell to another. The first time I run the macro
it would need to draw the arrow from B26 to B33, the next
time it might be C21 to B23. The cells it will be drawing
from and to are going to be changing every time the macro
is written. Any help with this is appreciated.

 

[Chip Pearson]

Jason,

Try something like the following:


Dim SH As Shape
Dim WS As Worksheet
Set WS = ActiveSheet
Dim StartCell As Range
Dim EndCell As Range

WS.Shapes.SelectAll
Selection.Delete

Set StartCell = Range("B6")
Set EndCell = Range("B33")

Set SH = WS.Shapes.AddLine( _
beginx:=StartCell.Left + StartCell.Width / 2, _
beginy:=StartCell.Top + StartCell.Height / 2, _
endx:=EndCell.Left + EndCell.Width / 2, _
endy:=EndCell.Top + EndCell.Height / 2)

With SH.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.ForeColor.RGB = RGB(255, 0, 0)
End With

 

[JASon]

Exactly what I was looking for. Thanks Chip!

-----Original Message-----
Jason,

Try something like the following:


Dim SH As Shape
Dim WS As Worksheet
Set WS = ActiveSheet
Dim StartCell As Range
Dim EndCell As Range

WS.Shapes.SelectAll
Selection.Delete

Set StartCell = Range("B6")
Set EndCell = Range("B33")

Set SH = WS.Shapes.AddLine( _
beginx:=StartCell.Left + StartCell.Width / 2, _
beginy:=StartCell.Top + StartCell.Height / 2, _
endx:=EndCell.Left + EndCell.Width / 2, _
endy:=EndCell.Top + EndCell.Height / 2)

With SH.Line
.EndArrowheadStyle = msoArrowheadTriangle
.EndArrowheadLength = msoArrowheadLengthMedium
.EndArrowheadWidth = msoArrowheadWidthMedium
.ForeColor.RGB = RGB(255, 0, 0)
End With


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
www.cpearson.com (e-mail address removed)





.