Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Arrow keys moving whole excel sprdsht insted of from cell to cell | New Users to Excel | |||
How do i make the arrow keys tab to the next cell? | Excel Discussion (Misc queries) | |||
how to delete the little red arrow in excell work sheet block | Excel Worksheet Functions | |||
How do I make my arrow buttons move from cell to cell in Excel? | Excel Discussion (Misc queries) | |||
If I have the zip code can I make it put the city in another cell | Excel Worksheet Functions |