Microsoft Excel

Herbers Excel/VBA-Archiv

Inhaltsverzeichnis erstellen | Herbers Excel-Forum


Betrifft: Inhaltsverzeichnis erstellen von: Rene
Geschrieben am: 15.12.2009 10:25:07

Hallo Experten,

ich habe in Excel eine Liste mit Arbeitsmappen. Nun möchte ich aus diesen Mappen die Tabellblattnamen auslesen und daraus in Inhaltsverzeichnis (welches verlinkt ist) erstellen.

C:\xxx\ccc.xls
C:\ddd\rrr.xls
.....

ich versuche schon seit einigen TAgen aus mehreren Excel-Arbeitsmappen die Tabellenblatt-Namen auszulesen. Bisher habe ich nur folgendes Makro gefunden.

Da ich von Schleifen nur sehr wenig weiß, wäre ich für eure Hilfe dankbar.

Sub Inhaltsverzeichnis()
Dim Tabelle As Worksheet
Dim i As Integer
  Worksheets.Add.Move before:=Worksheets(1)
  ActiveSheet.Name = "Inhalt"
  Cells(2, 2).Value = "Inhalt"
  i = 3
  For Each Tabelle In ActiveWorkbook.Worksheets
    If Tabelle.Name <> "Inhalt" Then
      Cells(i, 2).Value = Tabelle.Name
      Tabelle.Hyperlinks.Add Anchor:=Cells(i, 2), _
      Address:="", SubAddress:=Tabelle.Name & "!A1"
      i = i + 1
    End If
  Next Tabelle
End Sub

Mein Ziel wäre ein INhaltsverzeichnis mit folgendem Aussehen:

C:\xxx\xxx.xls Tabelle1 (verlinkt)
C:\xxx\xxx.xls Tabelle2 (verlinkt)
.....

Mit besten Dank im Voraus.

Gruß

  

Betrifft: AW: Inhaltsverzeichnis erstellen von: Björn B.
Geschrieben am: 15.12.2009 14:12:23

Hallo Rene,

ich verstehe Deine Frage nicht:

ich habe in Excel eine Liste mit Arbeitsmappen. 

Was soll das heißen, Du hast in einer Tabelle mehrere Dateinamen eingetragen oder was?
Und die möchtest du durchgehen und pro Mappe dann die Tabellennamen auslesen?

Bitte etwas besser erklären.
Wie sieht Deine Liste aus?

Gruß
Björn B.


  

Betrifft: AW: Inhaltsverzeichnis erstellen von: Rene
Geschrieben am: 15.12.2009 21:38:18

Hallo Björn,

entschuldige die undeutliche Formulierung meines Problems.

Ich habe in einer Excelmappe ein Tabellenblatt in der eine Liste mit den Tabellennamen enthalten ist.

Die Liste in der Excelmappe - in der auch das Inhaltsverzeichnis eingefügt werden sollte - sieht folgendermaßen aus:

C:\Daten\Arbeitsmappe1.xls (Hyperlink)
C:\Daten\Arbeitsmappe2.xls (Hyperlink)
C:\Daten\User\Arbeitsmappe3.xls (Hyperlink)
C:\Daten\User\Arbeitsmappe4.xls (Hyperlink)
usw....

Ich möchte nun diese Arbeitmappen nach der Reihe durchgehen und die enthaltenen Tabellenblätter auslesen, sodass das Ergebnis folgendermaßen aussieht:

C:\Daten\Arbeitsmappe1.xls\Tabelle1 oder einfach nur Tabelle1 (Hyperlink)
C:\Daten\Arbeitsmappe1.xls\Tabelle2 oder einfach nur Tabelle2 (Hyperlink)
C:\Daten\Arbeitsmappe1.xls\Tabelle3 oder einfach nur Tabelle3 (Hyperlink)
C:\Daten\Arbeitsmappe2.xls\Tabelle1 oder einfach nur Tabelle1 (Hyperlink)
C:\Daten\Arbeitsmappe2.xls\Tabelle2 oder einfach nur Tabelle2 (Hyperlink)
C:\Daten\Arbeitsmappe2.xls\Tabelle3 oder einfach nur Tabelle3 (Hyperlink)
C:\Daten\user\Arbeitsmappe1.xls\Tabelle1 oder einfach nur Tabelle1 (Hyperlink)
C:\Daten\user\Arbeitsmappe1.xls\Tabelle2 oder einfach nur Tabelle2 (Hyperlink)
C:\Daten\user\Arbeitsmappe1.xls\Tabelle3 oder einfach nur Tabelle3 (Hyperlink)
C:\Daten\user\Arbeitsmappe2.xls\Tabelle1 oder einfach nur Tabelle1 (Hyperlink)
C:\Daten\user\Arbeitsmappe2.xls\Tabelle2 oder einfach nur Tabelle2 (Hyperlink)
C:\Daten\user\Arbeitsmappe2.xls\Tabelle3 oder einfach nur Tabelle3 (Hyperlink)

Das erstellte Inhaltsverzeichnis sollte auch mittels Hyperlink auf die jeweilige Tabelle verlinkt sein.

Gruß


René


  

Betrifft: AW: Inhaltsverzeichnis erstellen von: Rene
Geschrieben am: 15.12.2009 21:42:07

Hab vergessen, Frage noch offen.

Lg René


  

Betrifft: AW: Inhaltsverzeichnis erstellen von: Josef Ehrensberger
Geschrieben am: 15.12.2009 23:57:51

Hallo René,

probier mal.

' **********************************************************************
' Modul: Modul3 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function GetSheetNames(ByVal File As String) As Variant
  'original by Bob Phillips, adapted by j.ehrensberger
  Dim objADO_Connection As Object, objADO_Catalog As Object, objADO_Tables As Object
  Dim lngIndex As Long, intLength As Integer, intPos As Integer, intStart As Integer
  Dim strConString As String, strTable As String
  Dim varTmp() As Variant
  
  If Dir(File, vbNormal) = "" Then Exit Function
  
  strConString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & File & ";" & _
    "Extended Properties=Excel 8.0;"
  
  Set objADO_Connection = CreateObject("ADODB.Connection")
  objADO_Connection.Open strConString
  Set objADO_Catalog = CreateObject("ADOX.Catalog")
  Set objADO_Catalog.ActiveConnection = objADO_Connection
  
  For Each objADO_Tables In objADO_Catalog.Tables
    strTable = objADO_Tables.Name
    intLength = Len(strTable)
    intPos = 0
    intStart = 1
    'Worksheet name with embedded spaces enclosed by single quotes
    If Left(strTable, 1) = "'" And Right(strTable, 1) = "'" Then
      intPos = 1
      intStart = 2
    End If
    'Worksheet names always end in the "$" character
    If Mid$(strTable, intLength - intPos, 1) = "$" Then
      Redim Preserve varTmp(lngIndex)
      varTmp(lngIndex) = Mid$(strTable, intStart, intLength - (intStart + intPos))
      lngIndex = lngIndex + 1
    End If
  Next objADO_Tables
  
  If lngIndex > 0 Then GetSheetNames = varTmp
  
  objADO_Connection.Close
  Set objADO_Catalog = Nothing
  Set objADO_Connection = Nothing
  
End Function

Sub createLinks()
  Dim rng As Range, objHL As Hyperlink
  Dim lngRow As Long, lngFirstRow As Long, lngLastRow As Long
  Dim lngIndex As Long, lngCol As Long, vntSheets As Variant
  
  lngFirstRow = 2 'erste Datenzeile - Anpassen!
  lngCol = 1 'Spalte mit den Hyperlinks - Anpassen!
  
  With Sheets("Tabelle1") 'Tabellenname - Anpassen!
    lngLastRow = Application.Max(lngFirstRow, .Cells(Rows.Count, 1).End(xlUp).Row)
    lngRow = lngFirstRow
    For Each objHL In .Range(.Cells(lngFirstRow, 1), .Cells(lngLastRow, 1)).Hyperlinks
      vntSheets = GetSheetNames(objHL.Address)
      If IsArray(vntSheets) Then
        For lngIndex = 0 To UBound(vntSheets)
          .Hyperlinks.Add Anchor:=.Cells(lngRow, 2), _
            Address:=objHL.Address & "#" & vntSheets(lngIndex) & "!A1", _
            SubAddress:="", _
            TextToDisplay:=objHL.Address & "#" & vntSheets(lngIndex) & "!A1"
          lngRow = lngRow + 1
        Next
      End If
    Next
    .Range(.Cells(lngFirstRow, 1), .Cells(.Rows.Count, 1)).Delete xlToLeft
    .Columns(1).AutoFit
  End With
  
End Sub



Gruß Sepp



  

Betrifft: AW: Inhaltsverzeichnis erstellen von: Rene
Geschrieben am: 19.12.2009 21:15:39

Hallo Sepp,

danke für deine rasche Hilfe. Funktioniert super. Habe nur

.Range(.Cells(lngFirstRow, 1), .Cells(.Rows.Count, 1)).Delete xlToLeft
.Columns(1).AutoFit

entfernt und bin mit dem Ergebnis zufrieden.

Gruße René


Beiträge aus den Excel-Beispielen zum Thema "Inhaltsverzeichnis erstellen"