AW: Perfekt. Vielen Dank
25.07.2012 00:01:12
fcs
Hallo Nimzo,
ich hab jetzt mal verschiedene Varianten für Werte und Formeln in Spalte F probiert.
Unter Excel 2010 kommt dann immer die entsprechende Meldung das Verbindung nicht existiert oder die allgemeine Fehlermeldung.
Probiere mal die folgenden Varianten. Hier werden die Namen der vorhandenen Verbindungen mit den Namen in Spalte F verglichen und bei Übereinstimmung gelöscht.
Gruß
Franz
Sub RemoveConnections()
'Löscht die Verbindungen/Connections, deren Namen in einem Zellbereich stehen
Dim rngData As Range, rngZelle As Range, varElement As Variant, bolDeleted As Boolean
Dim wkbAktiv As Workbook
Dim strMsgText As String, strMsgTitel As String, lngMsgButtons As Long
strMsgTitel = "Makro: Remove Connections"
lngMsgButtons = vbInformation + vbOKOnly
On Error GoTo Fehler
Set wkbAktiv = ActiveWorkbook
If wkbAktiv.Connections.Count > 0 Then
With ActiveSheet
'Bereich mit Verbindungsnamen F2:Fxxx
Set rngData = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
If rngData.Row >= 2 Then
For Each rngZelle In rngData
If rngZelle "" Then
For Each varElement In wkbAktiv.Connections
If LCase(varElement.Name) = LCase(rngZelle.Text) Then
varElement.Delete
bolDeleted = True
Exit For
End If
Next varElement
If bolDeleted = False Then
lngMsgButtons = vbInformation + vbRetryCancel
strMsgText = "Verbindung """ & rngZelle.Text & """ existiert nicht!"
If MsgBox(strMsgText, lngMsgButtons, strMsgTitel) = vbCancel Then Exit For
End If
End If
Next
Else
strMsgText = "Keine Verbindungseinträge im Bereich " & rngData.Address
MsgBox strMsgText, lngMsgButtons, strMsgTitel
End If
End With
Else
strMsgText = "Aktive Datei hat keine Verbindungen"
MsgBox strMsgText, lngMsgButtons, strMsgTitel
End If
Fehler:
lngMsgButtons = vbInformation + vbOKOnly
With Err
Select Case .Number
Case 0 'alles OK
Case 9 'Index-Fehler in Auflisttung - Name ist falsch
lngMsgButtons = vbInformation + vbRetryCancel
strMsgText = "Verbindung """ & rngZelle.Text & """ existiert nicht!"
If MsgBox(strMsgText, lngMsgButtons, strMsgTitel) = vbRetry Then
Resume Next
End If
Case Else
strMsgText = "Fehler-Nr.: " & .Number & vbLf & .Description
MsgBox strMsgText, lngMsgButtons, strMsgTitel
End Select
End With
End Sub
Sub RemoveConnections_kurz()
'Löscht die Verbindungen/Connections, deren Namen in einem Zellbereich stehen
Dim rngData As Range, rngZelle As Range, varElement As Variant
Dim wkbAktiv As Workbook
On Error Resume Next
Set wkbAktiv = ActiveWorkbook
If wkbAktiv.Connections.Count > 0 Then
With ActiveSheet
'Bereich mit Verbindungsnamen F2:Fxxx
Set rngData = .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp))
If rngData.Row >= 2 Then
For Each rngZelle In rngData
If rngZelle "" Then
For Each varElement In wkbAktiv.Connections
If LCase(varElement.Name) = LCase(rngZelle.Text) Then
varElement.Delete
Exit For
End If
Next varElement
End If
Next
End If
End With
End If
End Sub