Erstellen Sie eine Indexliste aller Tabellen mit ihrem Namen in ListObject-Tabellenspalte

Question

Ich möchte eine Indexliste aller Tabellen mit ihren Namen in einer Tabellenspalte erstellen.

Bis jetzt habe ich den folgenden Code geschrieben, aber es gibt einen Fehler in einer zitierten Zeile.

Dim ws As Worksheet, tbl As ListObject, i As Integer 
Set ws = Sheets("Profile Management") 
Set tbl = ws.ListObjects("sheets") 
With tbl.ListRows 
Do While .Count >= 1 
.Item(1).Delete 
Loop 
End With 

For i = 1 To Sheets.Count 
"tbl.ListColumns(1).DataBodyRange = Sheets(i).Name" 
Next I 

Wohin gehe ich falsch?

Answer 1

Arbeiten mit strukturierten (aka Listobject) Tabellen bringt einige zusätzliche Probleme zu VBA. Sie können nicht auf diese Weise in die .DataBodyRange property schreiben und die .DataBodyRane ist ein Mitglied der ListObject, nicht die ListObject ListColumns property.

Option Explicit 

Sub wqwe() 
    Dim tbl As ListObject, i As Long, w As Long 

    With Worksheets("Profile Management") 
     With .ListObjects("sheets") 
      'make sure there is at least 1 row in the databodyrange 
      If .DataBodyRange Is Nothing Then _ 
       .ListRows.Add 
      'clear the first column 
      .DataBodyRange.Columns(1).ClearContents 
      'insert the worksheet names 
      For w = 1 To Worksheets.Count 
       'except "Profile Management" 
       If Worksheets(w).Name <> .Parent.Name Then 
        i = i + 1 
        'expand the table for new worksheets 
        .DataBodyRange.Cells(i, 1) = Worksheets(w).Name 
        'optionally insert a hyperlink to each worksheet's A1 
        .Parent.Hyperlinks.Add Anchor:=.DataBodyRange.Cells(i, 1), _ 
         Address:=vbNullString, SubAddress:=Worksheets(w).Name & "!A1", _ 
         TextToDisplay:=Worksheets(w).Name, ScreenTip:="click to go there" 
       End If 
      Next w 
      'reshape the table if there are blank rows 
      Do While i < .ListRows.Count 
       .ListRows(i + 1).Delete 
      Loop 
     End With 
    End With 
End Sub 

Wie oben in den Kommentaren erwähnt, habe ich die Option hinzugefügt, um jedes Arbeitsblatt aus der Notierung in der Tabelle direkt auf Hyperlink. Wenn Sie diese Route wählen, müssen Sie den Namen nicht zuerst in die Tabellenzelle eingeben.

Answer 2

Folgendes ist viel einfacher.

Sub GetWorksheetNames() 
     Dim i As Long 



     ThisWorkbook.Worksheets("Profile Management").Cells(1, 1).Value = "Worksheet Inventory" 
     For i = 1 To ThisWorkbook.Worksheets.Count 
      ThisWorkbook.Worksheets("Profile Management").Cells(i + 1, 1).Value = ThisWorkbook.Worksheets(i).Name 
     Next i 
    End Sub