Inhaltsverzeichnis / "fremde" Datei
26.12.2004 07:03:50
Erich
mit Hilfe des Forums kann ich bereits für eine aktive Datei ein Inhaltsverzeichnis
erstellen, mit folgendem Code:
Option Explicit
Sub inhaltsverzeichnis_erstellen()
'Inhaltsverzeichnis aller Tabellenblätter
'im erten Tabellenblatt ab Zeile A1 einfügen
Dim blatt As Object
Dim zeile As Double
Dim NewSheet As Worksheet
Dim i As Integer
zeile = 3
'Fehlerhandling
On Error Resume Next
'Abfrage unterdrücken
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sheet Inhaltsverzeichnis auf jeden Fall löschen
Sheets("Inhaltsverzeichnis").Delete
'Neues Tabellenblatt mit dem Namen Inhaltsverzeichnis hinzufügen
Set NewSheet = Worksheets.Add
NewSheet.Name = "Inhaltsverzeichnis"
Sheets("Inhaltsverzeichnis").Move Before:=Sheets(1) ' = Tabellenblatt als erstes
'Überschrift Einfügen und formatieren
With Sheets("Inhaltsverzeichnis").Range("A1")
.Value = "Inhaltsverzeichnis"
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Font.Underline = xlUnderlineStyleSingle
End With
With Cells(1, 2)
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
With Cells(1, 3)
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
With Cells(2, 1)
.Value = "sortiert nach Blatt-Nr."
.Font.Name = "Arial"
.Font.Size = "16"
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
With Cells(2, 5)
.Value = "alphabetisch sortiert"
.Font.Name = "Arial"
.Font.Size = "16"
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
'Laufende Blattnummerierung + Blattname einfügen
For Each blatt In Sheets
Sheets("Inhaltsverzeichnis").Cells(zeile, 1).Value = "Blatt " & zeile - 2
Sheets("Inhaltsverzeichnis").Cells(zeile, 2).Value = blatt.Name
Sheets("Inhaltsverzeichnis").Hyperlinks.Add Anchor:=Cells(zeile, 2), Address:="", SubAddress:="'" & _
blatt.Name & "'!A1", TextToDisplay:=blatt.Name
zeile = zeile + 1
Next blatt
ActiveSheet.Columns("B:B").EntireColumn.AutoFit
'Kopiere die zwei erstellten Spalten und sortiere Hyperlinks
Range("A3", Range("B65536").End(xlUp)).Select
Selection.Copy
Range("D3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D3", Range("E65536").End(xlUp)).Select
Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Columns("D:E").EntireColumn.AutoFit
ActiveWindow.DisplayGridlines = False
Range("A3").Select
ActiveWindow.FreezePanes = True
Cells(1, 4).Select
'Userform ausblenden
'frmInhaltsverz.Hide
'Ursprungszustand wieder herstellen
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Wie muss ich den Code (am Anfang) ergänzen, wenn ich von einer nicht aktiven /
fremden Datei das Inhaltsverzeichnis (= Namen der Tabellenblätter) erstellen
will.
Besten Dank für eine Hilfe!
mfg
Erich