none
How to draw an arrow between two selected cells? RRS feed

  • Question

  • Hi,

    I'm using VS 2015 and Excel 2016 to create my custom ribbon. 

    I want a customized function that when I click the button and then select another cell to draw an arrow.

    Like the image present, the activecell is A1 and when I click the button and then select A5 and the arrow is programmatically drew.

    http://i.imgur.com/337POxS.jpg 

    Please help me!

    Thanks in advance.

    Monday, March 6, 2017 11:17 AM

Answers

  • Hi AuditorQQ -

    Since you are working in VS and Excel, I presume you have familiarity w/ listening to the worksheet events, etc.

    Here's the gist code you could use. I've mocked it up in vba because it's handy at the moment & I don't know if you are in C# or VB. The changes are easy (remove Set, etc...)

    Basically you need to add a shape line to the worksheet from the SelectionChange event of the worksheet - but you don't want to draw a line everytime a cell is selected, hence the button. To do this, use your button click to set a Boolean variable to true. The SelectionChange event of the worksheet then calls the following sub, passing the clicked cell (Target) into the sub:

    Public boolEnableArrowDraw As Boolean       ' Set this when the button is clicked
    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        If boolEnableArrowDraw Then
            Call DrawArrowFromA1(Target)
        End If
    End Sub
    
    Public Sub DrawArrowFromA1(rngTo As Excel.Range)
        Dim wksActive As Excel.Worksheet
        Dim rngFrom As Excel.Range
        Dim shArrow As Excel.Shape
        Dim lngXStart As Long, lngYStart As Long
        Dim lngXEnd As Long, lngYEnd As Long
        
        On Error Resume Next
        Set wksActive = rngTo.Worksheet
        Set rngFrom = wksActive.Range("A1")
        
        lngXStart = rngFrom.Left + rngFrom.Width / 2
        lngXEnd = rngTo.Left + rngTo.Width / 2
        lngYStart = rngFrom.Top + rngFrom.Height / 2
        lngYEnd = rngTo.Top + rngTo.Height / 2
        
        Set shArrow = wksActive.Shapes.AddConnector(msoConnectorStraight, lngXStart, lngYStart, lngXEnd, lngYEnd)
        shArrow.Line.EndArrowheadStyle = msoArrowheadTriangle
        shArrow.Line.ForeColor.RGB = RGB(255, 0, 0)
        boolEnableArrowDraw = False
        Set shArrow = Nothing
        Set rngFrom = Nothing
        Set wksActive = Nothing
        
    End Sub
    Hope this gets you going -


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.

    • Marked as answer by AuditorQQ Tuesday, March 7, 2017 9:36 AM
    Monday, March 6, 2017 2:20 PM

All replies

  • Hi AuditorQQ -

    Since you are working in VS and Excel, I presume you have familiarity w/ listening to the worksheet events, etc.

    Here's the gist code you could use. I've mocked it up in vba because it's handy at the moment & I don't know if you are in C# or VB. The changes are easy (remove Set, etc...)

    Basically you need to add a shape line to the worksheet from the SelectionChange event of the worksheet - but you don't want to draw a line everytime a cell is selected, hence the button. To do this, use your button click to set a Boolean variable to true. The SelectionChange event of the worksheet then calls the following sub, passing the clicked cell (Target) into the sub:

    Public boolEnableArrowDraw As Boolean       ' Set this when the button is clicked
    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        If boolEnableArrowDraw Then
            Call DrawArrowFromA1(Target)
        End If
    End Sub
    
    Public Sub DrawArrowFromA1(rngTo As Excel.Range)
        Dim wksActive As Excel.Worksheet
        Dim rngFrom As Excel.Range
        Dim shArrow As Excel.Shape
        Dim lngXStart As Long, lngYStart As Long
        Dim lngXEnd As Long, lngYEnd As Long
        
        On Error Resume Next
        Set wksActive = rngTo.Worksheet
        Set rngFrom = wksActive.Range("A1")
        
        lngXStart = rngFrom.Left + rngFrom.Width / 2
        lngXEnd = rngTo.Left + rngTo.Width / 2
        lngYStart = rngFrom.Top + rngFrom.Height / 2
        lngYEnd = rngTo.Top + rngTo.Height / 2
        
        Set shArrow = wksActive.Shapes.AddConnector(msoConnectorStraight, lngXStart, lngYStart, lngXEnd, lngYEnd)
        shArrow.Line.EndArrowheadStyle = msoArrowheadTriangle
        shArrow.Line.ForeColor.RGB = RGB(255, 0, 0)
        boolEnableArrowDraw = False
        Set shArrow = Nothing
        Set rngFrom = Nothing
        Set wksActive = Nothing
        
    End Sub
    Hope this gets you going -


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.

    • Marked as answer by AuditorQQ Tuesday, March 7, 2017 9:36 AM
    Monday, March 6, 2017 2:20 PM
  • Hi MainSleuth 

    I'm very appreciated your work and I think that's exactly what I need. But I might have some trouble translating your code into VB, however there is no error message. 

    Public Class Ribbon1 Public boolEnableArrowDraw As Boolean Private Sub Ribbon1_Load(ByVal sender As System.Object, ByVal e As RibbonUIEventArgs) Handles MyBase.Load End Sub Private Sub Arrow_Click(sender As Object, e As RibbonControlEventArgs) Handles Arrow.Click boolEnableArrowDraw = True End Sub

    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If boolEnableArrowDraw = True Then Call DrawArrowFromA1(Target) End If End Sub Public Sub DrawArrowFromA1(rngTo As Excel.Range) Dim wksActive As Object = Globals.ThisAddIn.Application.ActiveSheet Dim rngFrom As Object = Globals.ThisAddIn.Application.ActiveCell Dim shArrow As Excel.Shape Dim lngXStart As Long, lngYStart As Long Dim lngXEnd As Long, lngYEnd As Long On Error Resume Next lngXStart = rngFrom.Left + rngFrom.Width / 2 lngXEnd = rngTo.Left + rngTo.Width / 2 lngYStart = rngFrom.Top + rngFrom.Height / 2 lngYEnd = rngTo.Top + rngTo.Height / 2 shArrow = Globals.ThisAddIn.Application.ActiveSheet.Shapes.addconnector _ (Microsoft.Office.Core.MsoConnectorType.msoConnectorStraight, lngXStart, lngYStart, lngXEnd, lngYEnd) With shArrow .Line.Weight = 3 .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.EndArrowheadStyle = Microsoft.Office.Core.MsoArrowheadStyle.msoArrowheadTriangle End With End Sub End Class

    Just before I saw your reply. The idea came to me that maybe I can use inputbox to get the second cell's location value so that I can draw a line between the original activecell and the second one. I might need some time figure it out what went wrong or try this new idea. Thank you anyway!

    Monday, March 6, 2017 4:41 PM
  • I see what appears to be mixed references & Object references where you are losing code claity.

    But precidely, this statement,

    Dim rngFrom As Object = Globals.ThisAddIn.Application.ActiveCell

    is simply setting the 'From' Cell equal to the Target cell. You are getting a line to/from the same point. As I understood your requirement, the rngFrom is 'A1' of the Target Cell worksheet, hence the construct used should have been rewritten as:

            Dim wksActive As Excel.Worksheet = rngTo.worksheet
           
    Dim rngFrom As Excel.Range = wksActive.range("A1")

    Aside from that, I'm not sure what your exactly referencing with 'Globals.ThisAddIn.Application' - presumable a reference that resolves to Excel.Application & not Excel. In my vb (Studio) projects, I use a statement like

    Imports Excel = Microsoft.Office.Interop.Excel

    which stops short of the Excel.Application because the Excel Objects (like WOrkbook, worksheet, Shape) are available at the Excel Class layer; whereas the Instance items like ActiveSheet, ThisWorkbook, etc are available t the Excel.Application layer. THis also helps make things a little more readable. If 'Globals.THisAddIn.Application' does resolve to Excel and you are using an imports alias statement to reference the Interop.Excel, you ought to be OK.


    -MainSleuth You've Got It, Use It! Engineering, Science, Statistics Solutions http://ToolSleuth.com. For any reply that either helps to answer your question or is the answer, please mark it as helpful or as the answer so others with the same question will have an answer quickly.


    • Edited by MainSleuth Tuesday, March 7, 2017 5:25 AM Leftover edits
    Tuesday, March 7, 2017 5:25 AM
  • Hi MainSleuth, 

    Thank you for replying me so kindly again.

    The question I asked originally might not be clearly, The arrow I want to draw is not stuck to cell A1 but relatively to the cell user selected at first.

    Below is the code I wrote finally solved my problem. I have to admit I'm totally new to code in VB, so your advice really helps me clarifying my thoughts. Thank you sincerely.

        Private Sub RedArrow_Click(sender As Object, e As RibbonControlEventArgs) Handles RedArrow.Click
            Dim appCell As Object = Globals.ThisAddIn.Application.ActiveCell
            Dim app As Object = Globals.ThisAddIn.Application
            Dim connector As Object
            Dim Left As Double = appCell.Left
            Dim Top As Double = appCell.Top
    
            Dim location As Object
            location = app.inputbox("Selet a cell", "Drawing an arrow", Type:=8)
            Dim TargetLeft As Double = location.left
            Dim TargetTop As Double = location.Top
            Dim TargetHeight As Double = location.Height
    
    
            connector = app.ActiveSheet.Shapes.addconnector _
                (Microsoft.Office.Core.MsoConnectorType.msoConnectorStraight,
                 Left + 4, Top, TargetLeft + 4, TargetTop + TargetHeight)
            With connector
                .line.weight = 2
                .line.ForeColor.RGB = RGB(255, 0, 0)
                .Line.EndArrowheadStyle = Microsoft.Office.Core.MsoArrowheadStyle.msoArrowheadTriangle
            End With
        End Sub


    Tuesday, March 7, 2017 9:50 AM