Werte kopieren, pdf speichern und widerh
21.11.2022 22:38:50
KevKiel
ich habe in einer Exceldatei zwei Tabellenblätter:
"Whg" --> Hier liegen im Bereich A2:A10 9 verschiedene Kostenstellen
"Betriebskostenabrechnung" --> Hier ist ein Bericht (Anzeige von Planwerten Umsatz/Ertrag etc.) welche sich nach der WohnungsNr als Kriterium verändern. Die Daten dazu liegen in einer Datenbank. Ein kopieren der Nr reicht, damit sich die Werte verändern.
Per "Knopfdruck" soll nacheinander für jede Wohnungsnummer die Werte ermittelt werden und der Tabellenreiter "Betriebskostenabrechnung" als pdf gedruckt werden.
Soweit so schwer.
Ich bin in VBA grob so vorgegangen:
Schleife, wenn die Kostenstelle Whg.A2 mit dem Kriterium Betriebskostenabrechnung.B2 übereinstimmt, drucke das pdf. Danach nehme Whg.A3 und kopiere das nach Betriebskostenabrechnung.B2. Danach wieder Druck des pdf. Die Dateinamen orientieren sich am Kriterium.
Das Skript bricht leider an verschiedenen Stellen ab (Mal Laufzeitfehler 9 mal öffnet er eine neue Exceldatei mit den Werten, welche er eigentlich als pdf abspeichern soll).
Ich habe dazu ein VBA Skript gebastelt:
Sub Kriterien_tauschen()
Dim WohnungsNrAktuell, WohnungsNrVorher As Long
Dim ZeileListe, ZeileVerteilung As Long
Dim SpalteVerteiler As Long
Dim BlattAbr, BlattWhg As String
Dim KritDruck As Long
Dim ZeileKrit, SpalteKrit As Long
BlattAbr = "Betriebskostenabrechnung"
BlattWhg = "Whg"
ZeileVerteilung = 2
SpalteVerteiler = 1
ZeileKrit = 2
SpalteKrit = 2
WohnungsNrVorher = Sheets(BlattWhg).Cells(ZeileVerteilung, SpalteVerteiler)
WohnungsNrAktuell = 0
For ZeileListe = ZeileVerteilung To FLZ(BlattWhg)
'was ist die Wohnungsnummer der aktuellen Zeile?
WohnungsNrAktuell = Sheets(BlattAbr).Cells(ZeileKrit, SpalteKrit)
'wenn die Wohnungsnummer der Wohnungsnummer aus der vorherigen Zeile entspricht, dann aus Liste kopieren und in WohnungsNraktuell einfügen
If WohnungsNrAktuell = WohnungsNrVorher Then
Sheets(BlattAbr).Cells(ZeileKrit, SpalteKrit).Value = Sheets(BlattWhg).Cells(ZeileVerteilung, SpalteVerteiler).Value
'Variable für "Zeilenvorschub" auf BlattWhg erhöhen
ZeileVerteilung = ZeileVerteilung + 1
Else
Call Pdf_Druck
Sheets(BlattAbr).Cells(ZeileKrit, SpalteKrit).Value = Sheets(BlattWhg).Cells(ZeileVerteilung, SpalteVerteiler).Value
'Variable für "Zeilenvorschub" erhöhen
ZeileVerteilung = ZeileVerteilung + 1
End If
WohnungsNrAktuell = WohnungsNrVorher
Next ZeileListe
Call Pdf_Druck
MsgBox ("Vorgang abgeschlossen")
End Sub
Public Sub Pdf_Druck()
Dim Dateiname As String
Dim BlattAbr2 As String
BlattAbr2 = "Betriebskostenabrechnung"
'I2 = Pfad; I4 = Dateiname; I5 = Jahr; B2 = Wohnungsnummer
Dateiname = Range("I2") & Range("I4") & "_" & Range("I5") & "_" & Range("B2") & ".pdf"
Range("E8:P78").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Dateiname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
Public Function FLZ(BlattWhg)
'Hier wird die letzte Zeile ermittelt
Dim LetzteZeile
FLZ = Sheets(BlattWhg).UsedRange.SpecialCells(xlCellTypeLastCell).Row
End Function