Objektvariable nicht festgel., Makroprogrammierung

Private Function Kundenanalyse(lSpalte As Long, DocTitelText As String, _
Dateiname1 As String, sYYYY_MM As String) As Boolean
'In einer Schleife die Kundenanlyse-Datei je Spaltenkriterium erstellen
'lSpalte        = Nummer der Spalte mit dem Kriterium, nach dem die Daten _
auf die anderen Dateien verteilt werden sollen
'DocTitelText   = Text der in die Dokumenteigenschaften eingebaut wird
'Dateiname1     = 1. Teil des Dateinamens der generierten Dateien
'sYYYY_MM       = Text, der in den Dateinamen und die Dokumenteigenschaften _
eingebaut wird.
Dim iCount As Long, oListe As New Collection, oItem, lItem As Long
Dim sDateiAnalyse As String
Dim rngPivot As Range, pvTab As PivotTable, pvField As PivotField, _
pvCache As PivotCache
Dim wksPivot As Worksheet
On Error GoTo Fehler
Application.StatusBar = "Liste der " & StatusTxt & " wird ermittelt"
'Liste der unterschiedlichen Einträge in der Spalte
With wksRohdaten
For iCount = 2 To .Cells(.Rows.Count, lSpalte).End(xlUp).Row
If .Cells(iCount, lSpalte)  "" Then
oListe.Add Item:=.Cells(iCount, lSpalte), Key:=CStr(.Cells(iCount, lSpalte))
End If
Next
End With
'Kundenanlysedatei für Regionalzentren/Kundenberater erstellen
lItem = 0
For Each oItem In oListe
'Dateiname der Kundenanalyse-Datei
sDateiAnalyse = Dateiname1 & sYYYY_MM & "_" & oItem
lItem = lItem + 1
Application.StatusBar = StatusTxt & ": Datei " & lItem & " von " & oListe.Count _
& " wird erstellt (" & sDateiAnalyse & ")"
'Blatt "MA" der Ausgangsdatendatei in eine neue Arbeitsmappe kopieren
wbAusgang.Sheets("MA").Copy
Set wbAnalyse = ActiveWorkbook
With wbAnalyse
'Weitere Blätter in neue Datei kopieren
wbAusgang.Sheets("Landkreis").Copy after:=.Sheets(.Sheets.Count)
wbAusgang.Sheets("Daten").Copy after:=.Sheets(.Sheets.Count)
'Leeres Tabellenblatt für die Analysedaten am Ende einfügen
.Worksheets.Add after:=.Sheets(.Sheets.Count)
Set wksAnalyse = .Sheets(.Sheets.Count)
'Analyseblatt umbenennen
wksAnalyse.Name = "Kd.-Analyse"
'Dokumenteigenschaften anpassen
.BuiltinDocumentProperties("Title") = DocTitelText & oItem
.BuiltinDocumentProperties("Subject") = "Verkaufsanalyse" & " - " & sYYYY_MM
.BuiltinDocumentProperties("Author") = Application.UserName
.BuiltinDocumentProperties("Manager") = ""
.BuiltinDocumentProperties("Keywords") = ""
.BuiltinDocumentProperties("Comments") = ""
'Datei speichern - schon vorhande Datei gleichen Namens wird ohne Rückfrage _
überschrieben
Application.DisplayAlerts = False
.SaveAs Filename:=sPfad & sDateiAnalyse, FileFormat:=.FileFormat
Application.DisplayAlerts = True
End With
With wksRohdaten
'Titelzeile aus Rohdaten kopieren und formatieren
.Rows(1).Copy Destination:=wksAnalyse.Cells(1, 1)
With wksAnalyse
With .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
.VerticalAlignment = xlBottom
.Orientation = xlUpward
.HorizontalAlignment = xlCenter
.EntireRow.AutoFit
End With
End With
'Fenster in Zelle H2 fixieren
Range("h2").Select
ActiveWindow.FreezePanes = True
'Daten für Regionalzentrum/Kundenberater aus Rohdaten übertragen
.AutoFilter.Range.AutoFilter Field:=lSpalte, Criteria1:=oItem
.Range(.Rows(2), .Cells(.Rows.Count, lSpalte).End(xlUp).EntireRow).Copy _
Destination:=wksAnalyse.Cells(2, 1)
End With
With wksAnalyse
'Spaltenbreiten optimieren
.Columns.AutoFit
'Datenbereich für Pivotauswertung
Set rngPivot = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, _
.Cells(1, .Columns.Count).End(xlToLeft).Column))
'Autofilter aktivieren
rngPivot.AutoFilter
End With
'Pivottabellenbericht(e) einrichten
'Diesen PivotCache könnte man auch für mehrere Pivottabellen nutzen - minimiert die Dateigrö _
ße
Set pvCache = wbAnalyse.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=rngPivot, Version:=xlPivotTableVersion11) _
'Die Version ggf. von 11 (Excel 2003) auf eine älere Version setzen)
'Leertabelle für Pivotbericht anfügen
wbAnalyse.Worksheets.Add after:=wksAnalyse
Set wksPivot = ActiveSheet
With wksPivot
.Name = "Pivot"
'Pivottabelle erstellen - Leergerüst
Set pvTab = pvCache.CreatePivotTable(tabledestination:=.Range("A4"), _
Tablename:="Analyse01", _
defaultversion:=xlPivotTableVersion11)
End With
With pvTab
'Felder zum Bericht hinzufügen
.AddFields RowFields:=Array("GBZ", "NameGBZ"), _
ColumnFields:=Array("Deb_passiv", "Int_Inaktiv"), _
PageFields:=Array("PLZ_3", "PLZ_5")
'Datenbereichsfeld(er) einrichten und formatieren
Set pvField = .AddDataField(Field:=.PivotFields("GBZ"), _
Caption:="Anzahl Einträge", _
Function:=xlCount)
With pvField
.NumberFormat = "#.##0"
End With
'Zeilenbereichsfeld(er) formatieren
Set pvField = .RowFields("NameGBZ")
With pvField
.AutoSort Order:=xlAscending, Field:="NameGBZ"
End With
'Spaltenbereichsfeld(er) formatieren
With .ColumnFields("Deb_passiv")
.AutoSort Order:=xlAscending, Field:="Deb_passiv"
End With
With .ColumnFields("Deb_passiv")
.AutoSort Order:=xlAscending, Field:="Int_Inaktiv"
End With
'Summenwerte für Zeilen und Spalten anzeigen ?
.RowGrand = False
.ColumnGrand = True
End With
'Erzeugte Datei speichern und schliessen
wbAnalyse.Save
wbAnalyse.Close
Next
Err.Clear
'Fehler-Behandlung
Fehler:
With Err
Select Case .Number
Case 0 'Alles in Ordnung
Kundenanalyse = True
Case 457 'Collection-Key wird versucht doppelt zuzuweisen
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbNewLine & .Description
Kundenanalyse = False
End Select
End With
End Function