Shape - AddConnector - Verbindung - Code...

Frage: Kann mir mal jemand grundsätzlich die Vorgehensweise beim einfügen von "Connectoren" per VBA aufzeigen? Und wie kann ich zwei "Shapes" mit einem Connector verbinden?

Dann würde mich noch interessieren, wie ich ein Makro auslösen kann, wenn ich auf einen der erstellten "Connectoren" klicke?

Hier noch eine Beispieldatei: Shape - AddConnector - Verbindung...

Option Explicit
Const lngColumn As Long = 5
Const lngRow As Long = 4
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Main 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 16.10.2012 
' Purpose   : Shapes.AddConnector Beispiel MIT Code bei Klick auf Linie... 
'-------------------------------------------------------------------------- 
Sub Main()
    Dim wksSheet As Worksheet
    Dim intCount As Integer
    Dim shpObject As Shape
    On Error GoTo Fin
    Set wksSheet = ThisWorkbook.Worksheets("Sheet1")
    For Each shpObject In wksSheet.Shapes
        If shpObject.TopLeftCell.Column = lngColumn Then shpObject.Delete
    Next shpObject
    For intCount = 1 To 3
        Set shpObject = wksSheet.Shapes.AddConnector _
            (intCount, 20, 20, 200, 120)
        With shpObject
            .Top = wksSheet.Cells(lngRow, lngColumn).Top
            .Left = wksSheet.Cells(lngRow, lngColumn).Left
            .OnAction = "Test"
            .Line.Weight = 3
            .Name = wksSheet.Range("A1").Value & intCount
        End With
        Set shpObject = Nothing
    Next intCount
Fin:
    Set shpObject = Nothing
    Set wksSheet = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Main_1 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 16.10.2012 
' Purpose   : Button 1 und Button 2 werden verbunden... 
'-------------------------------------------------------------------------- 
Sub Main_1()
    Dim wksSheet As Worksheet
    Dim shpObject As Shape
    Set wksSheet = ThisWorkbook.Worksheets("Sheet1")
    On Error Resume Next
    wksSheet.Shapes("Connector").Delete
    Err.Clear
    On Error GoTo Fin
    Set shpObject = wksSheet.Shapes.AddConnector _
        (msoConnectorCurve, 20, 20, 200, 120)
    With shpObject.ConnectorFormat
        .BeginConnect wksSheet.Shapes("Button 1"), 1
        .EndConnect wksSheet.Shapes("Button 2"), 1
        shpObject.RerouteConnections
        shpObject.Line.Weight = 2
        shpObject.Name = "Connector"
    End With
Fin:
    Set shpObject = Nothing
    Set wksSheet = Nothing
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
'-------------------------------------------------------------------------- 
' Module    : Module1 
' Procedure : Test 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 16.10.2012 
' Purpose   : Dieser Code wird ausgeführt, wenn auf eine der 
'             erstellten Linien geklickt wird... 
'-------------------------------------------------------------------------- 
Private Sub Test()
    Select Case ThisWorkbook.Worksheets("Sheet1"). _
        Shapes(Application.Caller).Name
        Case "Line1"
            MsgBox "I'm Line1"
        Case "Line2"
            MsgBox "I'm Line2"
        Case "Line3"
            MsgBox "I'm Line3"
        Case Else
        
    End Select
End Sub
'msoConnectorCurve = 3 = Curved connector 
'msoConnectorElbow = 2 = Elbow connector 
'msoConnectorStraight = 1 = Straight line connector 

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...