Thema Datum  Von Nutzer Rating
Antwort
Rot Automation pdf Druck für mehrere Kriterien
14.11.2022 13:58:27 GastK
NotSolved

Ansicht des Beitrags:
Von:
GastK
Datum:
14.11.2022 13:58:27
Views:
134
Rating: Antwort:
  Ja
Thema:
Automation pdf Druck für mehrere Kriterien

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Automation pdf Druck für mehrere Kriterien
14.11.2022 13:58:27 GastK
NotSolved