Tabellen - ListObjects vorhanden - prüfen und Informationen ausgeben...

Frage: In einer Tabelle habe ich mehrere Tabellen (ListObjects) eingefügt. Wie kann ich per VBA das Vorhandensein dieser Tabellen prüfen? Wenn möglich ohne "On Error Resume Next" oder sonstige Errorhandler.

In a table I have included several tables (ListObjects). How can I check for the existence of these tables via VBA? If possible without "On Error Resume Next" or other error handler.

Hier noch eine Beispieldatei / Here's a sample file:
Tabellen - ListObjects vorhanden - prüfen und Informationen ausgeben...[ZIP 20 KB]

' Variablendeklaration erforderlich
Option Explicit
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 23.10.2013
' Purpose   : Tabellen - ListObjects vorhanden und Informationen...
'--------------------------------------------------------------------------
Sub Main()
    ' Wenn die "Tabelle" Table1 im Sheet1 vorhanden ist dann...
    If fncListObjects("Table1", "Sheet1") = True Then
        MsgBox "ListObject exists!"
    ' Sonst...
    Else
        MsgBox "ListObject does not exist!"
    End If
End Sub
Sub Main_1()
    ' Wenn die "Tabelle" Table123 im Sheet1 vorhanden ist dann...
    If fncListObjects("Table123", "Sheet1") = True Then
        MsgBox "ListObject exists!"
    ' Sonst...
    Else
        MsgBox "ListObject does not exist!"
    End If
End Sub
Sub Main_2()
    ' Wenn die "Tabelle" Table1 im Sheet123 vorhanden ist dann...
    If fncListObjects("Table1", "Sheet123") = True Then
        MsgBox "ListObject exists!"
    ' Sonst...
    Else
        MsgBox "ListObject does not exist!"
    End If
End Sub
' Funktion die den Namen des Listobjektes und den Tabellenblattnamen
' jeweils als String erwartet und einen Boolean-Wert
' (Wahr oder Falsch) zurückliefert
Private Function fncListObjects(ByVal strName As String, _
    ByVal strSheet As String) As Boolean
    Dim objList As Object
    ' Wenn das übergebene Tabellenblatt vorhanden ist, dann...
    If fncSheetEx(strSheet) = True Then
        ' Gehe durch alle Listobjekte auf dem Tabellenblatt
        For Each objList In ThisWorkbook.Worksheets(strSheet).ListObjects
            ' Wenn der Name des Listobjektes übereinstimmt, dann...
            If objList.Name = strName Then
                ' Funktion gibt Wahr zurück
                fncListObjects = True
                ' Arbeit erledigt, verlasse die Funktion
                Exit Function
            Else
                ' Sonst gibt die Funktion Falsch zurück
                fncListObjects = False
            End If
        Next objList
    Else
        ' Das Tabellenblatt ist nicht vorhanden
        MsgBox "Worksheet does not exist!"
        ' Beendet sofort alle Makros, setzt alle Variablen zurück
        End
    End If
End Function
' Funktion um das Vorhandensein von Tabellenblättern zu prüfen
' Evaluate wertet einen String aus
' ISREF ist eine Worksheet Funktion die True/False bezogen auf
' eine gültige Zellreferenz zurückliefert
Private Function fncSheetEx(ByVal strSheet As String) As Boolean
    fncSheetEx = Evaluate("ISREF(" & strSheet & "!A1)")
End Function
' Alle Tabellen (ListObjects) - Namen, Bereich und Tablestyle ausgeben
Sub Main_3()
    Dim objList As Object
    For Each objList In ThisWorkbook.Worksheets(ActiveSheet.Name).ListObjects
        Debug.Print objList.Name
        Debug.Print objList.Range.Address(False, False)
        Debug.Print objList.TableStyle.NameLocal
    Next objList
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

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