AW: Prüfen ob Tabellenobjekt vorhanden
28.03.2013 10:40:17
Luschi
Hallo nette Anette,
hier mal 2 Lösungsvorschläge:
Function testListObjects1(xTabelle As String) As Variant
Dim myArr As Variant, i1 As Integer, i2 As Integer
i1 = ThisWorkbook.Worksheets(xTabelle).ListObjects.Count
If i1 > 0 Then
ReDim myArr(i1 - 1, 1)
For i2 = 1 To i1
myArr(i2 - 1, 0) = ThisWorkbook.Worksheets(xTabelle).ListObjects(i2).Name
myArr(i2 - 1, 1) = ThisWorkbook.Worksheets(xTabelle).ListObjects(i2).Range.Address
Next i2
End If
testListObjects1 = myArr
Erase myArr
End Function
Sub test1()
Dim myArr As Variant, sName As String, i As Integer
myArr = testListObjects1("Tabelle1")
If IsEmpty(myArr) Then
MsgBox "Die Tabelle enthält keine benutzerdefinierten Listen!", 48
Else
sName = ""
For i = 0 To UBound(myArr)
sName = sName & myArr(i, 0) & ": " & myArr(i, 1) & vbCrLf
Next i
MsgBox "Folgende besutzerdefinierten Listen sind in dieser Tabelle vorhanden:" & _
vbCrLf & vbCrLf & sName
End If
Erase myArr
End Sub
o d e r
Function testListObjects2(xTabelle As String) As Object
Dim myListObject As Object
If ThisWorkbook.Worksheets(xTabelle).ListObjects.Count = 0 Then
Set myListObject = Nothing
Else
Set myListObject = ThisWorkbook.Worksheets(xTabelle).ListObjects
End If
Set testListObjects2 = myListObject
Set myListObject = Nothing
End Function
Sub test2()
Dim myListObject As Object, oLO As ListObject
Dim sName As String, iIcon As Integer
Set myListObject = testListObjects2("Tabelle1")
If myListObject Is Nothing Then
sName = "Die Tabelle enthält keine benutzerdefinierten Listen!"
iIcon = vbExclamation
Else
sName = ""
For Each oLO In myListObject
sName = sName & oLO.Name & ": " & oLO.Range.Address & vbCrLf
Next oLO
sName = "Folgende besutzerdefinierten Listen sind in dieser Tabelle vorhanden:" & _
vbCrLf & vbCrLf & sName
iIcon = vbInformation
End If
Set oLO = Nothing
Set myListObject = Nothing
MsgBox sName, iIcon
End Sub
Gruß von Luschi
aus klein-Paris