code to make a block arrow point from cell A to cell B

[hermac]

Hello,
I'm looking for a piece of code to make an existing shape (block
arrow) point from one cell to another. I know how to refer to cells
and their properties. It's just the shape that I don't know how to
handle by vba.
Could you give me a hand or a reference?
Thanks

 

[Ryan H]

Is this what you are wanting?

Activecell.Value = ChrW(&H25BA)

 

[joel]

[I reocrded a macro while rotating the shape using the rotation bar o
the shape. Here is the recorded maco

Selection.ShapeRange.IncrementRotation 180

 

[hermac]

Is this what you are wanting?

Activecell.Value = ChrW(&H25BA)
--
Cheers,
Ryan





- Tekst uit oorspronkelijk bericht weergeven -

Thanks Ryan, but no, I inserted a shape from the Insert Menu > Shapes

Block Arrow and reshaped it with the handles( rotation, resizing

etc..) to make it begin in cell D20 and point to (end in) A8
The AutoShapeType = 34.
I would like to programm it (through resizing and rotating) to
originate in any other cell and stop in any other cell.
Thanks anyway.
Herman

 

[joel]

did you se my posting of rotating the arrow?

Selection.ShapeRange.IncrementRotation 180


A cell and a shape both have the following 4 properties

Left, Top, width, Height

They are pixel references where the top left of the screen is 0,
(x=width,y=height). These are similar to a coordinate axis except th
positive direction in the y direction is down the screen (top toward
bottom). So if you want a shape to go between columns B to C Yuse th
following


set MyLine = activesheet.shapes("Line 1")
MyLine.left = Range("B4")

MyLine.Left = Range("B4").left
MyLine.Width = (Range("C4").left + Range("C4").width)
Range("B4").lef

 

[hermac]

did you se my posting of rotating the arrow?

Selection.ShapeRange.IncrementRotation 180

A cell and a shape both have the following 4 properties

Left, Top, width, Height

They are pixel references where the top left of the screen is 0,0
(x=width,y=height).  These are similar to a coordinate axis except the
positive direction in the y direction is down the screen (top towards
bottom).  So if you want a shape to go between columns B to C Yuse the
following

set MyLine = activesheet.shapes("Line 1")
MyLine.left = Range("B4")

MyLine.Left = Range("B4").left
MyLine.Width = (Range("C4").left + Range("C4").width) -
Range("B4").left

--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:http://www.thecodecage.com/forumz/showthread.php?t=165603

Microsoft Office Help

Yes Joel, you put my nose in the good direction. Thank you.
The precise spot on the cell where the arrow points TO and on the cell
where it points FROM should depend on the relative position of those
cells.
So far I'm experimenting with this :

Sub Macro7()
Dim W As Shape
Dim Orig As Range, Dest As Range
Dim DHor As Double, DVer As Double, OHor As Double, OVer As Double


Set Orig = Application.InputBox("Origin Cell", Type:=8)
Set Dest = Application.InputBox("Destination Cell", Type:=8)
If Orig.Cells.Count <> 1 Or Dest.Cells.Count <> 1 Then
MsgBox "Ranges of of origin and destination must be single cells"
Exit Sub
End If
Select Case True
Case Dest.Column < Orig.Column And Dest.Row < Orig.Row 'Dest is
linksboven Orig
DHor = Dest.Offset(0, 1).Left: DVer = Dest.Offset(1, 0).Top
OHor = Orig.Left: OVer = Orig.Top
Case Dest.Column = Orig.Column And Dest.Row = Orig.Row 'Dest = Orig
MsgBox "Cells of Origin and Destination must be different"
Exit Sub
Case Dest.Column = Orig.Column And Dest.Row < Orig.Row 'Dest is boven
Orig
DHor = Dest.Left + Dest.Width / 2: DVer = Dest.Top + Dest.Height
OHor = DHor: OVer = Orig.Top

Case Dest.Column > Orig.Column And Dest.Row < Orig.Row 'Dest is
rechtsboven Orig
DHor = Dest.Left: DVer = Dest.Offset(1, 0).Top
OHor = Orig.Offset(0, 1).Left: OVer = Orig.Top

Case Dest.Column > Orig.Column And Dest.Row = Orig.Row 'Dest is
rechtsnaast Orig
DHor = Dest.Left: DVer = Dest.Top + Dest.Height / 2
OHor = Orig.Offset(0, 1).Left: OVer = DVer


Case Dest.Column > Orig.Column And Dest.Row > Orig.Row 'Dest is
rechtsonder Orig
DHor = Dest.Left: DVer = Dest.Top
OHor = Orig.Offset(0, 1).Left: OVer = Orig.Offset(1, 0).Top

Case Dest.Column = Orig.Column And Dest.Row > Orig.Row 'Dest is onder
Orig
DHor = Dest.Left + Dest.Width / 2: DVer = Dest.Top
OHor = DHor: OVer = Orig.Offset(1, 0).Top

Case Dest.Column < Orig.Column And Dest.Row > Orig.Row 'Dest is
linksonder Orig
DHor = Dest.Offset(0, 1).Left: DVer = Dest.Top
OHor = Orig.Left: OVer = Orig.Offset(1, 0).Top

Case Dest.Column < Orig.Column And Dest.Row = Orig.Row 'Dest is
linksnaast Orig
DHor = Dest.Offset(0, 1).Left: DVer = Dest.Top + Dest.Height / 2
OHor = Orig.Left: OVer = DVer
End Select
Set W = ActiveSheet.Shapes("Wijzer")
W.Top = (OVer + DVer) / 2
W.Left = (OHor + DHor) / 2
W.Width = Sqr(Application.SumSq((OHor - DHor), (OVer - DVer)))
W.Rotation = Application.Degrees(Atn((DVer - OVer) / (DHor - OHor)))
'trigonometric definition of the angle

End Sub

Problem is the exact meaning of Top and Left with block arrows.
Thanks a lot
Herman

 

[joel]

The origin or a shape is the upper left corner. when placing them on
worksheet the problem is the rows and columns on the sheet can chang
size but the shapes don't change size at the same time. Also each ro
can have a diferent height and every column can be a different width.
So you must adjust the size of the coluns and rows before you change th
position and size of a shape.


I only briefly looked at you code. I aggree that you want to cente
the arrows vertically by Getting the height and dividing by 2 to fin
the cnet oer the the shape and the of the verticle area where you ar
placing the shape on the workbook.


I don't think you want to do the same with the horizontal position bu
it may work. Yo have to realize there is a border around the cells tha
have a small dimension. When you place a shape at the left or to
position of a cell it will sit ontop or the border line around th
cells. So you want to make the shape a little smaller than the cell
distances.

You will see that if you use the code below the LeftSide and RightSid
give the same position. Yo uprobably want to have a little spac
between the two expecially if you have a visible border around you
cells.


Dim RightSide As Single
Dim LeftSide As Single
RightSide = Range("B2").Left + Range("B2").Width
LeftSide = Range("C2").Lef