Adding Connector with VBA in Excel

[MikeSmuts]

I am new to Tek-Tips and a "pliers & wire" (read crude novice) programmer with no formal training in this area (I'm a civil engineer).

I'm busy developing an Excel application to use at the office that has a Gantt chart as one of the modules (you know, a very basic MS Project type application). I am not using graphing techniques to do this.

I've got most of the basic coding sorted (click & drag to move the task item bars, linking tasks to show dependency, calculating critical path etc).

At the moment I link tasks (I use Image controls to model the task items as these have mouse events that prove usefull) with elbow connectors created with VBA after the user "shift clicks" on 2 task item bars that need to be linked. This seems very crude and I would like to allow the user to graphically indicate the 2 tasks that have to be linked (straight connector or similar drawn between tasks like in Project) prior to adding the actual elbow connector. I figure a connector of some sort is the way to go as this allows me to interrogate the connector to find the names of the 2 tasks that were linked as well as the link sites that would tell me the dependency type (finish-start, start-start, finish-finish etc).

For the life of me I cannot get the code for this sorted. Any help would be most appreciated.

 

[SkipVought]

Hi,

What is your actual question?

Where is the code that you are having a problem with?

If the question is, "how do I add a connector vual code?" turn on your macro recorder, add the connector and observe your generated code.

Skip,

_[red][/red]

 

[MikeSmuts]

Hi Skip

Thanx for the prompt response.

The question is this: I require help with developing the code to allow the user to dynamically (for lack of a better word) add a connector between 2 tasks.

What I should have mentioned is that the drawing toolbar will not be visible or available to the user at run time to allow the use of auto shapes and I therefore need to produce the code to take its place so to speak.

Creating the connector and connecting the start of it to a shape with code is easy enough, but the macro recorder does not help any further as it doesn't give me the code to update the connector end position coordinates as the user moves the mouse (with say the left button clicked while dragging) on its way to the 2nd shape that has to be linked to the connector's end.

At the moment I don't have any useable code to show for this (not even something that doesn't work), sorry.

Hope this makes my first post clearer

Regards

Mike

 

[SkipVought]

"At the moment I don't have any useable code to show for this."

Once you generate some code for adding a connector between two objects, as suggested earlier, post back with your code.

I'll wait.

Skip,

_[red][/red]

 

[SkipVought]

BTW, I'm an EE, with no formal training in VBA 15 years ago, probably where you are now.

Skip,

_[red][/red]

 

[MikeSmuts]

Hi Skip (again)

OK, here is how I select and connect two tasks in the Gantt chart at present:

Option Explicit

Dim ws As Worksheet
Dim DSMstart As Single, DSMend As Single            'Variables to identify ID's of Tasks  linked to update DSM matrix
Dim FirstBar As Shape, SecondBar As Shape
Dim ConnName As String


Private Sub TaskBar1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

'Initialise variables for connection
    Set ws = Worksheets("Sheet1")
    Call Initialise
    
'Check if this is 1st or 2nd Task being selected for connection (don't allow if same Task is selected twice)
    If Button = 1 And Shift = 1 And DSMstart = 0 Then
        DSMstart = 1
        Set FirstBar = ws.Shapes("TaskBar1")
    ElseIf Button = 1 And Shift = 1 And DSMend = 0 Then
        DSMend = 1
        If DSMstart = DSMend Then
            DSMend = 0
        End If
    End If

    If DSMstart <> 0 And DSMend <> 0 Then
        Set SecondBar = ws.Shapes("TaskBar1")
        
    'Add connector
        Call Connect
    End If

End Sub


Private Sub TaskBar2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

'Initialise variables for connection
    Set ws = Worksheets("Sheet1")
    Call Initialise
    
'Check if this is 1st or 2nd Task being selected for connection (don't allow if same Task is selected twice)
    If Button = 1 And Shift = 1 And DSMstart = 0 Then
        DSMstart = 2
        Set FirstBar = ws.Shapes("TaskBar2")
    ElseIf Button = 1 And Shift = 1 And DSMend = 0 Then
        DSMend = 2
        If DSMstart = DSMend Then
            DSMend = 0
        End If
    End If

    If DSMstart <> 0 And DSMend <> 0 Then
        Set SecondBar = ws.Shapes("TaskBar2")
        
        'Add connector
            Call Connect
    End If

End Sub


Private Sub TaskBar3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

'Initialise variables for connection
    Set ws = Worksheets("Sheet1")
    Call Initialise
    
'Check if this is 1st or 2nd Task being selected for connection (don't allow if same Task is selected twice)
    If Button = 1 And Shift = 1 And DSMstart = 0 Then
        DSMstart = 3
        Set FirstBar = ws.Shapes("TaskBar3")
    ElseIf Button = 1 And Shift = 1 And DSMend = 0 Then
        DSMend = 3
        If DSMstart = DSMend Then
            DSMend = 0
        End If
    End If

    If DSMstart <> 0 And DSMend <> 0 Then
        Set SecondBar = ws.Shapes("TaskBar3")
        'Add connector
            Call Connect
    End If

End Sub


Private Sub Initialise()

Set ws = Worksheets("Sheet1")
'Test if the Task selected is the start of a new link and clear variables if it is
    If DSMstart <> 0 And DSMend <> 0 Then
        DSMstart = 0
        DSMend = 0
    End If

End Sub


Private Sub Connect()

Set ws = Worksheets("Sheet1")

'Set connection name
    ConnName = FirstBar.Name & "conn" & SecondBar.Name

'Add new connector and set properties
    With ws.Shapes.AddConnector(msoConnectorElbow, 10, 10, 10, 10)
        .Name = ConnName
        .Line.EndArrowheadStyle = msoArrowheadTriangle
        .Line.EndArrowheadLength = msoArrowheadShort
        .Line.EndArrowheadWidth = msoArrowheadNarrow
        .OnAction = "EditConnectorMenu"
    End With

'Set connector formats
    With ws.Shapes(ConnName).ConnectorFormat
        .BeginConnect FirstBar, ConnectionSite:=4
        .EndConnect SecondBar, ConnectionSite:=2
    End With
    
'Adjust Task bar positions to reflect connector
    SecondBar.Left = FirstBar.Left + FirstBar.Width
    
'Update DSM matrix to reflect connection
    ws.Cells(DSMend, DSMstart).Value = 1
    
End Sub

This is probably as clear as mud, but the above assumes there are 3 shapes on the spreadsheet representing task items in the Gantt chart (TaskBar1,2 and 3 etc). The DSM is a grid of cells (matrix if you like) filled with 0's or 1's, depending on whether tasks are linked or not (but not important for the issue at hand; the DSM data gets used later to calculate task dependencies, critical paths etc).

You'll see that before connecting 2 tasks (activities) on the Gantt chart, the user selects the tasks by shift clicking on them. What I would like to do is have the user click on the first task to connect (anchor) the start of an autoshape connector to that task and then with mouse button 1 down, have the other (unconnected) end of the connector "stuck" to the mouse pointer while the user moves it across the screen to the task he wants to link to the first. Arriving at the 2nd task, the user "drops" the end point of the connector onto that task, at which point the code connects (anchors) the line to that task as well (BeginConnect, EndConnect methods?)

With the 2 tasks to be linked defined before the connector is applied (the way I do it above), creating a connector and connecting the tasks is easy enough, but what would the code look like given the scenario I explained here.

I'm not sure if you're familiar with MS Project, but I'm trying to emulate the graphical manner used there to indicate the tasks that have to be linked, ie "drawing a line" from the first to the second task.

I appreciate your patience!

Mike

 

[SkipVought]

Is what you are trying to do, when the user Shift+select an image shape, and then MOVES the mouse toward another image shape, you want a TEMPORARY LINE to start at the selected image shape and the other end to follow the mouse pointer until the other image shape is Shift+select, causing the connector to be in place?

Skip,

_[red][/red]

 

[MikeSmuts]

Skip

YES!!

My thinking is however that a line object has no intelligence and that having a temporary straight connector as the "indicator line" will allow me to find out which shapes have just been connected by the user (so I can update the DSM matrix). Once I have that, I'll delete the straight connector and replace it with an elbow to look more like a "proper" Gantt chart.

Mike

 

[SkipVought]

Why not do something with the SELECTED image shape, like change the BORDER or BackGround temporarly?

Skip,

_[red][/red]

 

[SkipVought]

but here's a LINE possibility...

    If Button = 1 And Shift = 1 And DSMstart = 0 Then
        DSMstart = 1
        Set FirstBar = ws.Shapes("TaskBar1")
        [b]TempLine FirstBar, 4    'determine Site from top, left, width & height properties somehow
[/b]

Sub TempLine(oFrom As Shape, nSite As Long)
    'Set connection name
    ConnName = oFrom.Name & "conn"
    
    With ActiveSheet
        With .Shapes.AddConnector(msoConnectorStraight, 10, 10, 10, 10)
            .Name = ConnName
            .Line.EndArrowheadStyle = msoArrowheadTriangle
            .Line.EndArrowheadLength = msoArrowheadShort
            .Line.EndArrowheadWidth = msoArrowheadNarrow
            .OnAction = "EditConnectorMenu"
        End With
    
        With .Shapes(ConnName).ConnectorFormat
            .BeginConnect oFrom, ConnectionSite:=nSite
        End With
    
    End With
End Sub

Skip,

_[red][/red]

 

[MikeSmuts]

Skip

I thought about changing the selected task properties temporarily as well, but thought I'd try the line thing first. Else where's the fun? I'm a sucker for punishment.

Anyway, its 01h20 here in South Africa. I'll try your other suggestions in the morning.

Thanx so far.

Cheers

Mike