On 29 dec, 16:52, joel 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