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

Is this what you are wanting?

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


"hermac" wrote:

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

On 29 dec, 13:55, Ryan H <Ry...@discussions.microsoft.com> wrote:
> Is this what you are wanting?
>
> Activecell.Value = ChrW(&H25BA)
> --
> Cheers,
> Ryan
>
>
>
> "hermac" wrote:
> > 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
> > .- Tekst uit oorspronkelijk bericht niet weergeven -
>
> - 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

On 29 dec, 16:52, joel <joel.43y...@thecodecage.com> wrote:
> 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/sh...d.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