|
Hallo Zusammen,
ich habe in einer .xlsb Exceldatei zwei Tabellenblätter:
"KST" --> Hier liegen im Bereich A2:A17 16 verschiedene Kostenstellen als String
"Immo" --> Hier ist ein Bericht (Anzeige von Planwerten Umsatz/Ertrag etc.) welche sich nach der Kostenstelle als Kriterium verändern. Die Daten dazu liegen in einer Datenbank. Ein kopieren der Kostenstelle reicht, damit sich die Werte verändern.
Per "Knopfdruck" soll nacheinander für jede Kostenstelle die Werte ermittelt werden und der Tabellenreiter "Immo" als pdf gedruckt werden.
Soweit so schwer.
Ich bin in VBA grob so vorgegangen:
Schleife, wenn die Kostenstelle KST.A2 mit dem Kriterium Immo.C7 übereinstimmt, drucke das pdf. Danach nehme KST.A3 und kopiere das nach Immo.C7. Danach wieder Druck des pdf.
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 Test_Liste_Verteilen()
'Dimensionen und Dateityp festlegen
Dim Dateiname As String
Dim Dateityp As String
Dim KST_Vor As String
Dim KST_Akt As String
Dim KSTVorlage As String
Dim BlattKopie As String
Dim SpalteVer As Long
Dim ZeileVer As Long
'Belegung der Dimensionen
Dateiname = "Planung"
Dateityp = ".pdf"
SpalteVer = 1 'Spalte in Blattliste für die Verteilung
ZeileVer = 2 'Zeile in Blattliste für die Verteilung. Meistens zweite Zeile, da noch eine Überschrift vorhanden ist
KSTVorlage = "KST"
KST_Vor = Sheets(KSTVorlage).Cells(SpalteVer, ZeileVer)
KST_Akt = 0
BlattKopie = "Immo"
'For-Next-Schleife:
'läuft ab Zeile 2, Zeile für Zeile im Blatt "KST" und kopiert diese Zeile ins Blatt Immo
'wenn eine neue Kostenstelle kommt, dann speichert er das Blatt als pdf und kopiert die Zeilen der nächsten Kostenstelle hinein.
For ZeileListe = ZeileVer To f_LETZTE_ZEILE_1(KSTVorlage)
'Was ist die Kostenstelle der aktuellen Zeile?
KST_Akt = Sheets(KSTVorlage).Cells(ZeileVer, SpalteVer)
'Wenn die Kostenstelle der Kostenstelle aus der vorherigen Zeile entspricht, dann aus Liste kopieren und in Immo einfügen
If KST_Akt = KST_Vor Then
'Zeile in BlattListe markieren und kopieren
Sheets(KSTVorlage).Cells(ZeileVer, SpalteVer).Select
Application.CutCopyMode = False
Selection.Copy
'Wechsel zum Blatt VERTEILUNG und einfügen
Sheets(BlattKopie).Cells(7, 3).Select 'Auswaehlen der Zelle C7 Bezug zur Kostenstelle
ActiveSheet.Paste
'Variable für "Zeilenvorschub" auf Blatt KSTVorlage erhöhen
ZeileVer = ZeileVer + 1
'Wenn eine neue Kostenstelle dran ist
Else
'Dateinamen zusammenbauen
DNAME = Sheets(KSTVorlage).Cells(ZeileVer - 1, SpalteVer)
DateinameS = DNAME
'... und speichern via Aufruf der Sub-Prozedur
Call VERTEILUNG_SPEICHERN("K", KST_Akt)
'Und weiter geht es mit dem kopieren und einfügen
'Zeile im Blatt Liste markieren und kopieren
Sheets(KSTVorlage).Cells(ZeileVer, SpalteVer).Select
Application.CutCopyMode = False
Selection.Copy
'Wechsel zum Blatt VERTEILUNG und einfügen
Sheets(BlattKopie).Cells(7, 3).Select 'Auswaehlen der Zelle C7 Bezug zur Kostenstelle
ActiveSheet.Paste
ZeileVer = ZeileVer + 1 'Zeilenvorschub
End If
KST_Vor = KST_Akt
Next ZeileListe
'nach letzter Zeile die letzte Datei speichern
VERNAME = Sheets(KSTVorlage).Cells(ZeileVer - 1, SpalteVer)
DateinameS = Dateiname & "_" & VERNAME
Call VERTEILUNG_SPEICHERN(Dateiname, KST_Akt)
MsgBox ("Vorgang abgeschlossen")
End Sub 'Nachfolgend wird die Sub-Prozedur aufgeführt
Public Function f_LETZTE_ZEILE_1(KSTVorlage)
'Hier wird die letzte Zeile ermittelt
'Egal in welcher Spalte sich die letzte Zeile befindet
'Es werden alle Spalten geprüft und die letzte Zeile ausgegeben
Dim LETZTEZEILE
f_LETZTE_ZEILE_1 = Sheets(KSTVorlage).UsedRange.SpecialCells(xlCellTypeLastCell).Row
End Function
Public Sub VERTEILUNG_SPEICHERN(Dateiname, KST_Akt)
Dim DATEIPFAD As String
DATEIPFAD = "@@@"
Sheets("Immo").Copy
DateinameS = Dateiname & KST_Akt
ActiveWorkbook.ActiveSheet.Cells(2, 3).Select 'Zelle oben selektieren
ActiveWorkbook.SaveAs DATEIPFAD & Dateiname
Workbooks(DateinameS & KST_Akt).Close
End Sub
|