Makro Verzeichnis erstellen
17.04.2016 17:52:43
obelix-xxl
das nachfolgenden Makro konnte ich bisher hervorragend nutzen. Leider funktioniert dieses jetzt nicht mehr. In der neuen Tabelle kommt immer wieder die Meldung:
Laufzeitfehler '9' Index ausserhalb des gültigen Bereichs
Da ich keinerlei VBA-Kenntnisse habe, wende ich mich an dieses Forum, um hier Unterstützung zu erhalten. Meine Tabellenblätter sind mit führender Ziffer benannt und haben keine Leerzeichen. In den Tabellenblättern ist der Tabellenblattname nicht in eine Zelle geschrieben, sondern sollte aus dem Registerreiter ausgelesen werden.
Vielleicht muss das bisher unter Excel 2003 laufende Makro an Excel 2007 oder höher angepasst werden?
Hier der betreffende Teile des Makros welcher beim Debuggen gelb hinterlegt ist:
ThisWorkbook.Worksheets(ws.Cells(c_Tab_Zeile1 + i,_Tab_Spalte_BlattName).Value).Move _
After:=ThisWorkbook.Worksheets(i - 1)
der gelbe Pfeil im Debugger zeigt auf: After:=ThisWorkbook.Worksheets(i - 1)
Hier das gesamte Makro:
' Blätter einer Mappe sortieren und Verzeichnisblatt führen
' (c) Matthias Köhler 2003
Option Explicit
'Namen des Verzeichnisblattes bestimmen
Const c_Name_Verzeichnisblatt = "_Verzeichnis"
'Konstanten des Verzeichnisses
Const c_Text_Font = "Arial"
Const c_Header_Zeile = 2
Const c_Header_Spalte = 2
Const c_Header_Text = "Inhaltsverzeichnis"
Const c_Header_Fontsize = 14
Const c_Tab_Zeile1 = c_Header_Zeile + 2
Const c_Tab_Spalte_BlattNr = c_Header_Spalte
Const c_Tab_Spalte_BlattName = c_Header_Spalte + 1
Const c_Tab_Spalte_BlattNr_Text = "Nr."
Const c_Tab_Spalte_BlattName_Text = "Blatt"
Const c_Tab_Fontsize = 11
Sub BlattVerzeichnis_als_erstes_Blatt_fuehren()
' BlattVerzeichnis_als_erstes_Blatt_fuehren
' wenn ein Verzeichnis bereits existiert -> löschen
' als erstes Blatt wird ein Verzeichnisblatt neu angelegt
' alle Blätter der Mappe alphabethisch sortiert eingetragen
' danach wird in der Arbeitsmappe entsprechend sortiert
'Bildschirmupdate abschalten
Application.ScreenUpdating = False
'Aufruf der Unterroutinen
Call VorhandenesBlattVerweis_loeschen
Call Verweisblatt_einfuegen
Call Verzeichnis_auf_Verzeichnisblatt_erstellen
Call Verzeichnis_auf_Verzeichnisblatt_sortieren
Call Verzeichnisblaetter_entsprechend_Verzeichnis_sortieren
'Ins Verzeichnisblatt wechseln
ThisWorkbook.Worksheets(1).Select
'Bildschirmupdate wieder einschalten
Application.ScreenUpdating = True
End Sub
Private Sub VorhandenesBlattVerweis_loeschen()
'löscht ggf. das vorhandene Verzeichnisblatt
'Fehlermeldungen abfangen und Nachfragen abschalten
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt).Delete
Application.DisplayAlerts = True
End Sub
Private Sub Verweisblatt_einfuegen()
ThisWorkbook.Worksheets.Add Before:=ThisWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Name = c_Name_Verzeichnisblatt
End Sub
Private Sub Verzeichnis_auf_Verzeichnisblatt_sortieren()
ThisWorkbook.Worksheets(1).Range(Cells(c_Tab_Zeile1 + 2, c_Tab_Spalte_BlattName), _
Cells(c_Tab_Zeile1 + ThisWorkbook.Worksheets.Count, c_Tab_Spalte_BlattName)).Sort _
Key1:=ThisWorkbook.Worksheets(1).Columns(c_Tab_Spalte_BlattName), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub
Private Sub Verzeichnisblaetter_entsprechend_Verzeichnis_sortieren()
Dim ws As Worksheet
Dim i As Integer
Set ws = ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt)
ws.Cells(1, 1).Select
For i = 2 To (ThisWorkbook.Worksheets.Count - 1)
ThisWorkbook.Worksheets(ws.Cells(c_Tab_Zeile1 + i, c_Tab_Spalte_BlattName).Value).Move _
After:=ThisWorkbook.Worksheets(i - 1)
Next i
End Sub
Private Sub Verzeichnis_auf_Verzeichnisblatt_erstellen()
Dim ws As Worksheet
Dim i As Long, l_zeile As Long, l_wsAnz As Long
'Tabellenblatt "Verzeichnis"
Set ws = ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt)
'Tabelle der Blätter aufbauen
l_zeile = c_Tab_Zeile1
'Überschriften
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Value = c_Tab_Spalte_BlattNr_Text
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Font.Bold = True 'Fett
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Value = c_Tab_Spalte_BlattName_Text
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Font.Bold = True 'Fett
'Tabelle mit Nr/Tabellenname füllen
l_wsAnz = ThisWorkbook.Worksheets.Count 'Anzahl Tabellenblaetter
For i = 1 To l_wsAnz
l_zeile = l_zeile + 1
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Value = i
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Value = ThisWorkbook.Worksheets(i).Name
Next i
'Tabelle formatieren
'Schriftart und -groesse,Ausrichtung der Spalte 1
ws.Range(Cells(c_Tab_Zeile1, c_Tab_Spalte_BlattNr), _
Cells(c_Tab_Zeile1 + l_wsAnz, c_Tab_Spalte_BlattNr)).Select
With Selection
.Font.Name = c_Text_Font
.Font.Size = c_Tab_Fontsize
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
'Schriftart und -groesse,Asurichtung der Spalte 2
ws.Range(Cells(c_Tab_Zeile1, c_Tab_Spalte_BlattName), _
Cells(c_Tab_Zeile1 + l_wsAnz, c_Tab_Spalte_BlattName)).Select
With Selection
.Font.Name = c_Text_Font
.Font.Size = c_Tab_Fontsize
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
'Spaltenbreite anpassen
ws.Columns(c_Tab_Spalte_BlattNr).AutoFit
ws.Columns(c_Tab_Spalte_BlattName).AutoFit
'Hauptueberschrift
With ws.Cells(c_Header_Zeile, c_Header_Spalte)
.Value = c_Header_Text
.Font.Bold = True 'Fett
.Font.Name = c_Text_Font
.Font.Size = c_Header_Fontsize
End With
End Sub
LG
obelix