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

 

[Rick Rothstein]

Maybe this?

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

 

[sonnychong]

it works!! thank you so much!! :D

may i ask another question? is there any codes that can makes the line to be placed somewhere in the middle of the cell instead of on the border? thanks in advance :D

 

[Rick Rothstein]

it works!! thank you so much!! :D

may i ask another question? is there any codes that can makes the line to be placed somewhere in the middle of the cell instead of on the border? thanks in advance :D

You are welcome. Here is my code modified to draw from the center of the upper left cell to the center of the bottom right cell of the selection (that means you can draw a diagonal line in a mult-row selection as well as for a single-row selection...

Sub DrawLineCenterToCenter()
  Dim ThisLine As Shape, LeftCell As Range, RightCell As Range
  
  Set LeftCell = Selection(1)
  Set RightCell = Range(Split(Selection.Address, ":")(1))
  
  Set ThisLine = ActiveSheet.Shapes.AddLine([COLOR=red][B]LeftCell.Left + LeftCell.Width / 2[/B][/COLOR], _
                                            [COLOR=seagreen][B]LeftCell.Top + LeftCell.Height / 2[/B][/COLOR], _
                                            [COLOR=royalblue][B]RightCell.Left - RightCell.Width / 2 + RightCell.Width[/B][/COLOR], _
                                            [COLOR=purple][B]RightCell.Top + RightCell.Height / 2[/B][/COLOR])
  
  With ThisLine.Line
    .BeginArrowheadStyle = msoArrowheadOval
    .EndArrowheadStyle = msoArrowheadOval
    .BeginArrowheadWidth = msoArrowheadWidthMedium
    .BeginArrowheadLength = msoArrowheadLengthMedium
    .EndArrowheadWidth = msoArrowheadWidthMedium
    .EndArrowheadLength = msoArrowheadLengthMedium
    .Visible = msoTrue
  End With
End Sub

The red section controls the left coordinate for the left end of the line, the green section controls the top coordinate for the left end of the line, the blue section controls the distance over from the left coordinate to the right end of the line and the purple section controls the distance down from the top coordinate to the right end of the line.

 

[sonnychong]

awesome!!! thank you very much Rick Rothstein.

 

[sonnychong]

would like to ask another question.

if i would like to change the line thickness and line colour according to my boss' preference, which part of the code should i change?

 

[Rick Rothstein]

would like to ask another question.

if i would like to change the line thickness and line colour according to my boss' preference, which part of the code should i change?

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

The two added lines in red are needed to do those. The three arguments for the RGB function are numbers from 0 to 255 each and they represent the red, green and blue "strength values" making up the color. The weight values start at 1 and increment up from there (note that a value of 7 is very, very thick, so don't use too large a value for this property). Also note I added an error check (green line of code) to protect against the code crashing if run with only a single cell selected.

 

[sonnychong]

thanks!!

sorry for a bit demanding, but is it possible to make the macro draw the line even only 1 cell is selected?

sorry for the inconvenience caused.

 

[Rick Rothstein]

sorry for a bit demanding, but is it possible to make the macro draw the line even only 1 cell is selected?

How would that work? Remember, we are drawing from the center of the "first" cell to the cente of the last cell... if only one cell is selected, those two centers are the same point, so there would be no line.

 

[sonnychong]

thanks for the clarification. and thank you very much for the help :D