Registriert seit: 16.08.2014
Version(en): 2013
19.08.2014, 15:20
(Dieser Beitrag wurde zuletzt bearbeitet: 19.08.2014, 15:56 von Rabe.)
Hallo liebe Experten,
ich möchte gerne die Tabellenblattnamen aus einer geschlossenen Excel-Datei auslesen. Dazu habe ich mir ein kleines Programm geschrieben, das diese Namen ausgehend von der aktiven Zelle in meinem geöffneten Excel-Arbeitsblatt untereinander wiedergibt. Der Code funktioniert. Leider sind meine Programmierkenntnisse bescheiden. Wie könnte man das Programm eleganter schreiben?
Code: Option Explicit
Sub Blattnamenauslesen()
'Programm zum Auslesen der Tabellenblattnamen
'aus der geschlossenen Datei Datei.xls im Verzeichnis C:\Test
Dim sFile As String
Dim wb As Workbook
Dim vbFeld(1 To 100) As Variant
Dim i As Variant
Dim ws As Worksheet
Dim a As Integer
sFile = "C:\Test\Datei.xls"
i = 1
Set wb = Workbooks.Open(sFile)
For Each ws In wb.Worksheets
vbFeld(i) = ws.Name
i = i + 1
Next ws
wb.Close
a = 0
For Each i In vbFeld
ActiveCell.Offset(a, 0).Value = i
a = a + 1
Next i
End Sub
Code strukturiert dargestellt durch 3. Button von rechts im Beitragsformular: #
Moderator [Bild: smilie.php?smile_ID=1810]
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo,
vielleicht genügt dies Deiner Vorstellung an Eleganz?
Code: Sub Blattnamenauslesen()
'Programm zum Auslesen der Tabellenblattnamen
'aus der geschlossenen Datei Datei.xls im Verzeichnis C:\Test
Dim i As Long
Dim rngStart As Range
Dim sFile As String
Dim wb As Workbook
Set rngStart = ActiveCell
Set wb = Workbooks.Open("C:\Test\Datei.xls")
For i = 1 To wb.Worksheets.Count
rngStart.Offset(i - 1, 0).Value = wb.Worksheets(i).Name
Next i
wb.Close
End Sub
Gruß Uwe
Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:1 Nutzer sagt Danke an Kuwer für diesen Beitrag 28
• ratrad
Registriert seit: 16.08.2014
Version(en): 2013
Hallo leider funktioniert
dein Code noch nicht.
Klemmt bei ws
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo,
ja stimmt, da muss jetzt i stehen.
Gruß Uwe
Registriert seit: 16.08.2014
Version(en): 2013
Hallo Uwe,
danke für Deine Hilfe! Falls andere Leute aber noch andere Vorschläge haben, nur zu.
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo ratrad,
aus einer geschlossenen Mappe stimmt ja nun nicht, Du öffnest sie ja zum Auslesen. Es geht aber auch wirklich ohne Öffnen.
Geschlossen braucht einen etwas umfangreicheren code und geht so:
Code: Option Explicit
'benoetigt Verweis auf Microsoft ActiveX DataObjects
'2.x oder hoeher (getestet mit 2.8 und 6.1)
Private Function ListExcelTablesADOX(ByVal varFile As String, _
ListExcelTables As Collection) As Long
Dim objConnection As Object ' ADODB.Connection
Dim objAdoCat As Object ' ADOX.Catalog
Dim tbl As Object ' ADOX.Table
'ADODB Connection Objekt setzen - Late Binding
Set objConnection = CreateObject("adodb.connection")
'ADODB Catalog Objekt setzen - Late Binding
Set objAdoCat = CreateObject("adox.catalog")
'ADODB Connection Verbindung oeffnen
Set objConnection = OpenExcelConnection(varFile)
'Bei Fehler Gehe zu Fehlerbehandlung
On Error GoTo errorhandler
'Katalog aus ADODB Connection zuweisen
objAdoCat.ActiveConnection = objConnection
'Schleife ueber alle Tables
'Hinweis:
'1. Druckbereiche ets. werden ebenfalls als Table zurueckgegeben,
'2. Punkte in Tabellennamen werden in Tables durch hash ersetzt!
For Each tbl In objAdoCat.Tables
'wenn Tabellenname mit $ oder $' endet und
'nicht mit # oder '# beginnt, dann
If (Right(tbl.Name, 2) = "$'" Or Right(tbl.Name, 1) = "$") And _
(Left(tbl.Name, 1) <> "#" And Left(tbl.Name, 2) <> "'#") Then
'Tabellenname zur Collection hinzufuegen
ListExcelTables.Add tbl.Name
'Ende wenn Tabellenname mit $ oder $' endet und
'nicht mit # oder '# beginnt, dann
End If
'naechste Schleife ueber alle Tables
Next tbl
'Fehlerbehandlung
errorhandler:
'ADODB Catalog zuruecksetzen
Set objAdoCat = Nothing
'ADODB Connection schliessen
objConnection.Close
'ADODB Connection zuruecksetzen
Set objConnection = Nothing
'Wenn Fehler, dann Fehlernumer als Rueckgabewert
If Err Then ListExcelTablesADOX = Err.Number
End Function
Private Function OpenExcelConnection( _
ByVal Path As String, _
Optional ByVal Headers As Boolean = True) As Connection
Const adUseClient As Long = 3 ' noetig bei Late Binding
Dim strConn As String ' Connection - String, Versionsabhaengig
Dim objConn As ADODB.Connection ' Connection-Objekt
'Connection-Objekt initialisieren
Set objConn = New ADODB.Connection
'Wenn excel-Version >= 12, dann
If Val(Application.Version) >= 12 Then
'Connection-String mit ACE bilden
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""Excel 12.0;HDR=" & _
IIf(Headers, "Yes", "No") & """;"
'Oder nicht Wenn excel-Version >= 12, dann
Else
'Connection-String mit Jet bilden
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""Excel 8.0;HDR=" & _
IIf(Headers, "Yes", "No") & """"
'Ende Wenn excel-Version >= 12, dann
End If
'mit dem Connection Objekt
With objConn
'Cursor setzen
.CursorLocation = adUseClient
'Verbindung oeffnen
.Open strConn
'Ende mit dem Connection Objekt
End With
'Connection zurueckgeben
Set OpenExcelConnection = objConn
End Function
Public Sub BlattNamenHolen()
'Programm holt Blattnamen aus einer geschlossenen Mappe
'und trägt diese auf Tabelle1 ein.
'Variablendeklarationen
'Integer
Dim iCnt1%
'Long
Dim lo_Error&, loLetzte&
'string
Dim strPath$
'Collection
Dim ListExcelTables As New Collection 'Collection mit Blattnamen
'pfadvariable mit Pfad und Dateiname bilden
strPath = "D:\Test\x1.xlsx"
'Liste der Tabellenblaetter der Datei bilden, Rueckgabe Fehlerwert
lo_Error = (ListExcelTablesADOX(strPath, ListExcelTables))
'Mit dem Blatt Suche
With ThisWorkbook.Sheets("Tabelle1")
'Schleife bis zum Ende der Collection
For iCnt1 = 1 To ListExcelTables.Count
'erste freie Zelle anhand Spalte A ermitteln
loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(loLetzte, 1) = ListExcelTables(iCnt1)
'Naechste Schleife bis zum Ende der Collection
Next
'Ende Mit dem Blatt Suche
End With
'Blattliste zuruecksetzen
Set ListExcelTables = Nothing
End Sub
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 16.08.2014
Version(en): 2013
Hallo Andre,
danke für den Code, aber leider läuft er nicht. Habe eine X64 Version. Natürlich hast du recht. Die Datei bleibt nicht geschlossen und es wird ein bißchen dabei geschummelt.
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo ratrad,
Habe nur das 32er Office und kann daher nur raten, was die Ursache sein kann. Was kommt denn für eine Fehlermeldung?
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallöchen,
beim Auslesen von Tabellennamen weicht das Ergebnis etwas ab.
Es wird in der Regel ein $ an den Tabellennamen angehängt:
Tabelle1$
Tabelle2$
Enthalten die Tabellennamen Punkte, werden diese durch Hash ersetzt:
Tabelle#1$
Tabelle#2$
Tabelle#3$
Bei bestimmten Zeichen werden zusätzlich die Hochkomma am Anfang und Ende ausgegeben, analog z.B. zur Formeleingabe:
'Tabelle#3$'
'Tabelle,3$'
Allerdings ist bei den Ersatzzeichen kein eindeutiger Rückschluss auf die ersetzten Zeichen zu erwarten:
Tabelle!"§$%&()=`'_;
wird zu
'Tabelle_"§$%&()=_''_;$'
Hier sieht man noch den Sonderfall, dass ein Hochkomme im Namen ein zweites davor gesetzt bekommt.
Je nachdem, ob man mit Wildwuchs bei der Zeichenvergabe rechnen muss oder eine Systematik bei der Namensvergabe einhält, kann man reagieren oder auch nicht.
Sind z.B. nur die Indizees der Tabellenblätter durch einen Punkt vom Namen getrennt und es gibt keine weiteren "Besonderheiten", kann man den # durch einen Punkt ersetzen und nimmt den $ vom Ende weg.
Statt
Code: 'Tabellenname zur Collection hinzufuegen
ListExcelTables.Add tbl.Name
kann man dann so reagieren:
Code: 'Tabellenname zur Collection hinzufuegen
ListExcelTables.Add Replace(Replace(tbl.Name,"#","."),"$","")
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
31.05.2016, 04:01
(Dieser Beitrag wurde zuletzt bearbeitet: 31.05.2016, 04:01 von schauan.)
Hallöchen,
noch ein Hinweis. Sollte bei den Tabellennamen mit den Hochkommas am Anfang und Ende selbiges am Ende stören, kann man das beim Zelleintrag durch eine zusätzliche Codezeile entfernen:
nach dieser Zeile:
.Cells(loLetzte, 1) = ListExcelTables(iCnt1)
diese einfügen:
If Right(.Cells(loLetzte, 1), 1) = "" Then .Cells(loLetzte, 1) = Left(.Cells(loLetzte, 1), Len(.Cells(loLetzte, 1)) - 1)
Ein einfaches Replace des Hochkomma beim Auslesen würde nicht funktionieren. Dabei würde auch das Hochkomma am Anfang ersetzt und das ergibt beim Eintrag in die Zelle eine Zahl mit Dezimalstellen.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
|