help in drawing line with variable length using macro

[sonnychong]

hi there everyone. i've been searching in this forum for quite some time now, but this is my first post here.

i've got this code

Sub test2()
Dim ThisLine As Shape


    With ActiveCell
    Set ThisLine = ActiveSheet.Shapes.AddLine(.Left, .Top, .Left + .Width, .Top)
    End With
    
    With ThisLine.Line
    .BeginArrowheadStyle = msoArrowheadOval
    .EndArrowheadStyle = msoArrowheadOval
    .BeginArrowheadWidth = msoArrowheadWidthMedium
    .BeginArrowheadLength = msoArrowheadLengthMedium
    .EndArrowheadWidth = msoArrowheadWidthMedium
    .EndArrowheadLength = msoArrowheadLengthMedium
    .Visible = msoTrue
    End With

written by erik.van.geit (http://www.mrexcel.com/forum/showthread.php?t=264775&highlight=draw+line+on+spreadsheet).

this is kind of similar to what i'm searching for. but instead having the length of the line equal to the length of 1 cell, can the length of the line be determined by the amount of cells that i've selected.

eg: let's say on row 2, i've selected cells c2 to h2, and the line is drawn according to it. and on row 3, i've selected cells d3 to g3, and the line is drawn according to it.

anyone have any ideas how this can be done? thank you

 

[sonnychong]

Hi Rick Rothstein, thanks to your code and the one by erik.van.geit , I've managed to come out with something like this :

Sub DrawLine()
  
  Dim ThisLine As Shape, LeftCell As Range, RightCell As Range
  
  If Selection.Count = 1 Then
  
  With ActiveCell
    Set ThisLine = ActiveSheet.Shapes.AddLine(.Left, .Top + .Height / 2, .Left + .Width, .Top + .Height / 2)
 
  End With
  
  Else
  
    Set LeftCell = Selection(1)
    Set RightCell = Range(Split(Selection.Address, ":")(1))
  
    Set ThisLine = ActiveSheet.Shapes.AddLine(LeftCell.Left, LeftCell.Top + LeftCell.Height / 2, _
                                            RightCell.Left + RightCell.Width, RightCell.Top + RightCell.Height / 2)
    
  End If
  
    With ThisLine.Line
        .BeginArrowheadStyle = msoArrowheadOval
        .EndArrowheadStyle = msoArrowheadOval
        .BeginArrowheadWidth = msoArrowheadWidthMedium
        .BeginArrowheadLength = msoArrowheadLengthMedium
        .EndArrowheadWidth = msoArrowheadWidthMedium
        .EndArrowheadLength = msoArrowheadLengthMedium
        .ForeColor.RGB = RGB(255, 0, 0)
        .Weight = 2
        .Visible = msoTrue
    End With
End Sub

so far, after several attempts, there isn't any error. but would you help me check is there any circumstances that this macro will crash? very sorry for to bother you again. i promise this will be the last question

 

[Rick Rothstein]

Hi Rick Rothstein, thanks to your code and the one by erik.van.geit , I've managed to come out with something like this :

   ....Code Snipped for space

so far, after several attempts, there isn't any error. but would you help me check is there any circumstances that this macro will crash? very sorry for to bother you again. i promise this will be the last question

You can ask as many questions as you need to. The code looks stable to me; however, I decided to "simplify" it slightly by fixing the problem in the Split function when only one cell is selected... this allowed me to remove the If..Then..Else structure. This code should do what you want and is as stable as the code you posted...

Sub DrawLine()
  
  Dim ThisLine As Shape, LeftCell As Range, RightCell As Range
  
  Set LeftCell = Selection(1)
  Set RightCell = Range(Split(Selection.Address & ":" & Selection.Address, ":")(1))
  Set ThisLine = ActiveSheet.Shapes.AddLine(LeftCell.Left, LeftCell.Top + LeftCell.Height / 2, _
                                            RightCell.Left + RightCell.Width, RightCell.Top + RightCell.Height / 2)
  With ThisLine.Line
      .BeginArrowheadStyle = msoArrowheadOval
      .EndArrowheadStyle = msoArrowheadOval
      .BeginArrowheadWidth = msoArrowheadWidthMedium
      .BeginArrowheadLength = msoArrowheadLengthMedium
      .EndArrowheadWidth = msoArrowheadWidthMedium
      .EndArrowheadLength = msoArrowheadLengthMedium
      .ForeColor.RGB = RGB(255, 0, 0)
      .Weight = 2
      .Visible = msoTrue
  End With
  
End Sub

 

[sonnychong]

Thank you very much!!! You've help me alot :D