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