Drawing object references

J

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.
 
C

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
 
J

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)





.
 

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

Top