Thema Datum  Von Nutzer Rating
Antwort
Rot Werte kopieren, pdf speichern und widerholen
21.11.2022 09:49:22 GastVer
NotSolved
21.11.2022 10:43:02 Der Steuerfuzzi
NotSolved
21.11.2022 22:55:57 Der Steuerfuzzi
NotSolved
21.11.2022 23:16:49 Gast46637
NotSolved

Ansicht des Beitrags:
Von:
GastVer
Datum:
21.11.2022 09:49:22
Views:
136
Rating: Antwort:
  Ja
Thema:
Werte kopieren, pdf speichern und widerholen

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. 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 KritAktuell, KritVorher As Long
Dim ZeileListe, ZeileVerteilung As Long
Dim SpalteVerteiler As Long
Dim BlattDruck, BlattKrit As String
Dim KritDruck As Long
Dim ZeileKrit, SpalteKrit As Long

BlattDruck = "Immo"
BlattKrit = "KST"

ZeileVerteilung = 2
SpalteVerteiler = 1
ZeileKrit = 49
SpalteKrit = 8

KritVorher = Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler)
KritAktuell = 0

For ZeileListe = ZeileVerteilung To F_LetzteZeile(BlattKrit)

    'Was ist die Kostenstelle der aktuellen Zeile?
    KritAktuell = Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit)

    If KritAktuell = KritVorher Then
            
      'Zeile im Blatt Krit markieren und kopieren
      Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler).Select
      Application.CutCopyMode = False
      Selection.Copy
            
      'Wechsel zum Blatt Druck und einfügen
      Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit).Select
      ActiveSheet.PasteSpecial Paste:=xlPasteValues
            
      'Variable für "Zeilenvorschub" auf Blatt Krit erhöhen
      ZeileVerteilung = ZeileVerteilung + 1
    
    'Wenn eine neue Kostenstelle dran ist
    Else
      
      Call Pdf_Druck
      
      'Und weiter geht es mit dem kopieren und einfügen
      'Zeile im Blatt Liste markieren und kopieren
      Sheets(BlattKrit).Cells(ZeileVerteilung, SpalteVerteiler).Select
      Application.CutCopyMode = False
      Selection.Copy

      'Wechsel zum Blatt VERTEILUNG und einfügen
      Sheets(BlattDruck).Cells(ZeileKrit, SpalteKrit).Select
      ActiveSheet.PasteSpecial Paste:=xlPasteValues
            
      ZeileVerteilung = ZeileVerteilung + 1 'Zeilenvorschub
       
    
End If

      KritVorher = KritAktuell

Next

      'ZeileVerteilung
      Call Pdf_Druck
      
      
MsgBox ("Vorgang abgeschlossen")


End Sub

Public Function F_LetzteZeile(BlattKrit)

    '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_LetzteZeile = Sheets(BlattKrit).UsedRange.SpecialCells(xlCellTypeLastCell).Row
   
End Function


Public Sub Pdf_Druck()

Dim Dateiname As String

Dateiname = Range("H47") & Range("H49") & ".pdf"

Range("C1:BJ34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Dateiname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

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 Werte kopieren, pdf speichern und widerholen
21.11.2022 09:49:22 GastVer
NotSolved
21.11.2022 10:43:02 Der Steuerfuzzi
NotSolved
21.11.2022 22:55:57 Der Steuerfuzzi
NotSolved
21.11.2022 23:16:49 Gast46637
NotSolved