Office: (Office 2013) Automatischer PDF Druck (VBA)

Hallo zusammen

Vielleich kann mir ja jemand helfen, damit ich weniger Arbeit habe. :-)

Im Arbeitsblatt einer Excel-Datei würde ich gern Folgendes automatisieren:

Alle Zeilen ausblenden, wo in dem Bereich D18:D60 ein x steht.
Dann für den Bereich H1:O60 ein PDF erzeugen.
Dieses soll in den Ordner abgelegt werden, der in Zelle A4 steht.
Der Speichername des Dokuments soll sich aus den Zellen H10 und M5 zusammensetzen.

Dies soll für alle Mandanten gemacht werden. Dazu muss jede einzelne Mandantennummer, die in dem Bereich Q1:AX1 stehen, nacheinander in die Zelle J12 kopiert werden.

Bei einem Fehler, einem leeren Feld im Bereich Q1:AX1 oder einer Mandantennummer=0 soll kein PDF erzeugt werden, sondern der nächste Mandant genommen werden - bis alle durch sind.

Jeder Loop beginnt mit dem Kopieren der Mandantennummer, dann Zeilen ausblenden, PDF erzeugen und speichern - next.

Kann mir da jemand helfen? Überfordert definitiv meine Fähigkeiten.

Danke und Gruss

Taad

 

Hallo,

kopiere folgendes VBA-Makro in ein allgemeines Codemodul:

Code:

Option Explicit

Public Sub MandantenListe_Drucken()
  Dim Mandant As Range
  Dim KritZelle As Range, KritBereich As Range
  Dim PfadPDF As String, DateiPDF As String
  
  With ActiveSheet
  
    On Error GoTo NaechsterMandant
    Set KritBereich = .Range("D18:D60")
    
    'Für alle Mandanten im Mandantenbereich:
    For Each Mandant In .Range("Q1:AX1").Cells
      If Mandant.Value <> 0 Then
          'Für alle Mandanten, die nicht 0 oder leer sind:
          
          'Kopiere Mandantennummer:
          .Range("J12").Value = Mandant.Value
          
          'Blende alle Zeilen aus, die in KritBereich ein "x" haben;
          'alle anderen Zeilen blende (wieder) ein:
          For Each KritZelle In KritBereich.Cells
            With KritZelle
              .EntireRow.Hidden = .Value = "x"
            End With
          Next KritZelle
          
          'Lege Druckbereich fest = Bereich, der in die PDF-Datei ausgegeben wird:
          .PageSetup.PrintArea = "$H$1:$O$60"
          
          'Ermittle Pfad der PDF-Datei - dieser MUSS existieren:
          PfadPDF = .Range("A4").Value
          If Right(PfadPDF, 1) <> "\" Then PfadPDF = PfadPDF & "\"
          'Ermittle den Dateinamen der PDF-Datei:
          DateiPDF = .Range("H10").Value & .Range("M5").Value
          'Erzeuge die PDF-Datei:
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PfadPDF & DateiPDF, _
               Quality:=xlQualityStandard, IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, OpenAfterPublish:=False
      End If
NaechsterMandant:
    Next Mandant
    
    'Blende alle Zeilen wieder ein, falls welche noch ausgeblendet sind:
    For Each KritZelle In KritBereich.Cells
      KritZelle.EntireRow.Hidden = False
    Next KritZelle
    
  End With 'ActiveSheet
  
End Sub

 

Danke! Hat super geklappt!

LG, Taad