Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2
Default code to make a block arrow point from cell A to cell B

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default code to make a block arrow point from cell A to cell B


The origin or a shape is the upper left corner. when placing them on a
worksheet the problem is the rows and columns on the sheet can change
size but the shapes don't change size at the same time. Also each row
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 the
position and size of a shape.


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


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

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


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


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

Microsoft Office Help

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Arrow keys moving whole excel sprdsht insted of from cell to cell Ms-Exl-Learner New Users to Excel 2 December 17th 09 08:20 AM
How do i make the arrow keys tab to the next cell? Nadine Excel Discussion (Misc queries) 1 July 26th 09 01:48 AM
how to delete the little red arrow in excell work sheet block earledawg Excel Worksheet Functions 1 May 29th 08 02:09 PM
How do I make my arrow buttons move from cell to cell in Excel? slickd1200 Excel Discussion (Misc queries) 1 April 17th 06 05:42 PM
If I have the zip code can I make it put the city in another cell Carrie Excel Worksheet Functions 5 May 18th 05 08:26 PM


All times are GMT +1. The time now is 11:06 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"