Intelligente Tabellen auflisten

erichm · 2022-03-08T13:50:36+00:00

Hallo, ich habe mittlerweile mehrere intelligente Tabellen angelegt. Eine Übersicht findet sich im Namensmanager. Jetzt versuche ich verzweifelt, mir davon eine Liste ausdrucken bzw. in einem Tabellenblatt anzeigen zu lassen. Wenn ich die Liste vom Namensmanager anzeigen lasse, kommen aber immer nur die vergebenen Namen und nicht die intelligenten Tabellen. Geht das generell nicht oder gibt es einen Trick? Besten Dank für eine Hilfe. mfg

Hallo Eric,
leider nicht mit der Lösung von Chris. Da muss man auf Nepumuks Vorschlag zurückgreifen und leicht anpassen.
Ich habe natürlich mit den Anpassungen übertrieben...
Du bekommst den Namen des Arbeitsblatts, Namen der ListObject, Range des LO und Header-Liste. In eine separaten Worksheet.


Public Sub ListObject_auflisten()
Dim ws As Worksheet
Dim LO As ListObject
Dim F As Range
Dim Headers As String
With WähleOderHerstelle("ListObjectListe", "Arbeitsblatt", "Tabelle", "Bereich", "Felder")
For Each ws In ThisWorkbook.Worksheets
For Each LO In ws.ListObjects
Headers = ""
For Each F In LO.HeaderRowRange.Cells
Headers = Headers & ", " & F.Value
Next
.Range("A9999").End(xlUp).Range("A2:D2") = Array(ws.Name, LO.Name, LO.DataBodyRange.Address(0, 0), Mid(Headers, 3))
Next
Next
End With
End Sub
Private Function WähleOderHerstelle(Blattname, ParamArray Headers()) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(Blattname)
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = Blattname
Else
ws.Cells.ClearContents
End If
ws.Range("A1").Resize(1, UBound(Headers) + 1) = Headers
Set WähleOderHerstelle = ws
End Function

VG
Yal

Hallo Yal,
also der Code funktioniert sehr gut und das Ergebnis ist optimal.
Da ich den Code für mehrere Dateien benötige, speichere ich diesen in der PERSONL.xla ab. Wenn ich EXCEL öffne, erhalte ich immer eine Übersicht angezeigt, bei der ich diese Makros aufrufen kann. Das ist sehr komfortabel. Wenn ich jedoch diesen Code dort abspeichere und aufrufen will, dann klappt das nicht. Ich vermute, dass ich eine oder zwei bestimmte Stellen im Code ändern müsste - aber da reichen meine Kenntnisse leider nicht.
Mein Code beim öffnen von EXCEL und Anzeige der Liste der Makros (ich habe hier als Beispiel nur den Auszug für
Druckvorschau / Vorschau
IntTabellen = Dein Code mit ListObject_auflisten
angezeigt)
Option Explicit


Private Sub Workbook_Open()
Dim i%
i = Application.CommandBars(1).Controls.Count
With Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:= _
msoControlButton, Before:=i + 1, Temporary:=True)
.Caption = "&IV zurück"
.OnAction = "IV_zurück"
.Style = msoButtonIconAndCaption
End With
With Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:= _
msoControlPopup, Before:=i + 1, Temporary:=True)
.Caption = "&Personl.xls"
With .Controls.Add(Type:=msoControlPopup, Temporary:=True)
.Caption = "&Druckvorschau"
With .Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = "&Bestand"
.OnAction = "Vorschau"
.Style = msoButtonIconAndCaption
End With
With .Controls.Add(Type:=msoControlButton, Temporary:=True)
.Caption = "&IntTabellen"
.OnAction = "IntTabellen"
.Style = msoButtonIconAndCaption
End With
End With
End Sub


Public Sub IntTabellen()
Dim ws As Worksheet
Dim LO As ListObject
Dim F As Range
Dim Headers As String
With WähleOderHerstelle("ListObjectListe", "Arbeitsblatt", "Tabelle", "Bereich", "Felder")
For Each ws In ThisWorkbook.Worksheets
For Each LO In ws.ListObjects
Headers = ""
For Each F In LO.HeaderRowRange.Cells
Headers = Headers & ", " & F.Value
Next
.Range("A9999").End(xlUp).Range("A2:D2") = Array(ws.Name, LO.Name, LO.DataBodyRange.Address(0, 0), Mid(Headers, 3))
Next
Next
End With
End Sub


Private Function WähleOderHerstelle(Blattname, ParamArray Headers()) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(Blattname)
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Name = Blattname
Else
ws.Cells.ClearContents
End If
ws.Range("A1").Resize(1, UBound(Headers) + 1) = Headers
Set WähleOderHerstelle = ws
End Function

Der Änderungsbedarf liegt evtl. bei ThisWorkbook?
Nochmals besten Dank für eine Hilfe.
mfg

Forumthread: Intelligente Tabellen auflisten

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial