Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1120to1124
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Inhaltsverzeichnis erstellen

Inhaltsverzeichnis erstellen
Rene
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ß

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Inhaltsverzeichnis erstellen
15.12.2009 14:12:23
Björn
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.
AW: Inhaltsverzeichnis erstellen
15.12.2009 21:38:18
Rene
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é
Anzeige
AW: Inhaltsverzeichnis erstellen
15.12.2009 21:42:07
Rene
Hab vergessen, Frage noch offen.
Lg René
AW: Inhaltsverzeichnis erstellen
15.12.2009 23:57:51
Josef
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

Anzeige
AW: Inhaltsverzeichnis erstellen
19.12.2009 21:15:39
Rene
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é

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige