VBA: Mehrseitiges PDF über Schleife

[ipod86]

Hallo, 

ich habe aktuell ein VBA (Dank dieses Forums hier erarbeitet) was mir für eine definierte Anzahl an Kalenderwochen über eine Schleife eine entsprechende Anzahl an Kalenderblättern für jede KW ausdruckt:

Code:

Sub drucken()
Dim i As Long
For i = Worksheets("Einstellungen").Range("C3") To Worksheets("Einstellungen").Range("C4")
    Worksheets("Kalender").Range("H20") = i
    Sheets(Array("Kalender")).PrintOut
Next
End Sub

Ist es möglich, dass stattdessen eine einzige PDF (im Querformat) mit entsprechend vielen Seiten generiert wird?

[derHoepp]

Moin,

wenn du einen entsprechenden Druckertreiber hast, mit dem du ein "Warten" auslösen kannst, wird das bestimmt funktionieren.

Einfacher ist es wohl, auf einem Arbeitsblatt viele deiner Formulare neben- und untereinander zu platzieren und die Seitenumbrüche passend einzustellen. Bei den einzelnen Datumswerten kannst du dich dann jeweils per Formel auf das Datum auf der "vorhergehenden" Papierseite beziehen. Dann benötigst du überhaupt kein VBA mehr.

Viele Grüße
derHöpp

[ipod86]

Im Moment mache ich es (wenn ich ein PDF möchte) auch mit einem PDF Drucker, der bei Bedarf erst "sammelt". 

Wollte es so Benutzerfreundlich wie möglich machen, da mehrere Personen (habe es für unsere Kita und deren anderen Kitas gemacht) mit arbeiten. 

Mit den mehrerern Seiten im Excel ist was umständlich. 
Wenn man nur KW 20 möchte könnte man ja einfach Seite 20 ausdrucken. 
Manche Kitas wollen aber das ganze Jahr auf einmal drucken. Dann müsste ich 52 (eher 104 Seiten, ist zweiseitig angelegt) Seiten im Dokument erstellen. Und all diese abändern wenn sich was am Dokument ändert.....

So sieht das Dokument aus. Hab grad am Handy nur eine alte Version mit viel zu kleinen Zellen und ohne Rückseite (da ist nochmal das Raster mit Datum drüber).


  Kalender2.pdf (Größe: 59,16 KB / Downloads: 3)

Edit:
Auf der Seite "Einstellungen" können die gewünschten KWs und as Jahr eingestellt werden.

[ralf_b]

Ich habe so etwas folgendermaßen umgesetzt.
Die benötigten Wochen werden jeweils in einzelnen Blättern neu angelegt und diese Blätter werden dann gedruckt und anschließend gelöscht. 
Das Drucken wird wie du es schon machst mittels Sheets(Array("Blatt1, Blatt2, Blatt3")).printout erledigt. 
Querformat oder Hochformat legst du mit dem Pagesetup fest. 
Der User bekommt davon nichts mit.

[ipod86]

Das hört sich auch gut an (auch wenn ich es nicht hinbekommen würde :P) . 
So müsste man mit einem PDF Drucker die Seiten nicht sammeln.

Der PDF Drucker wird jedoch nochoch benötigt. Oder?

[Kuwer]

Hallo,

Code:

Sub ExportZuPDF()
  Dim i As Long
  Dim wbAktuell As Workbook
  Dim wbTemp As Workbook
  Set wbAktuell = ActiveWorkbook
  Application.ScreenUpdating = False
  With wbAktuell
    For i = .Worksheets("Einstellungen").Range("C3").Value To .Worksheets("Einstellungen").Range("C4").Value
        .Worksheets("Kalender").Range("H20") = i
        If wbTemp Is Nothing Then
          .Worksheets("Kalender").Copy
          Set wbTemp = ActiveWorkbook
        Else
          .Worksheets("Kalender").Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
        End If
        ActiveSheet.PageSetup.Orientation = xlLandscape
    Next i
  End With
  With wbTemp
    .ExportAsFixedFormat Type:=xlTypePDF, _
                     Filename:="C:\Users\Kuwer\Documents\Excel\Mappe1.pdf", _
                      Quality:=xlQualityStandard, _
         IncludeDocProperties:=True, _
             IgnorePrintAreas:=False, _
             OpenAfterPublish:=True
    .Close False
  End With
  Application.ScreenUpdating = True
End Sub

Gruß Uwe

[ipod86]

Da kapier ich nur Bahnhof. 
Wusste bisher garnicht, was mit VBA alles möglich ist. Hab bisher nur mal automatisch ein paar Spalten gelöscht ?

Habe meinen Laptop auf der Arbeit, werde das wenn ich heute Nachmittag anfange sofort testen.

Auch hier nochmal ein Lob für eure Hilfe.

EDIT
Im Moment scheint ja ein fester Pfad für das PDF hinterlegt zu sein.
Der kann sich natürlich von Rechner zu Rechner unterscheiden.

Ist auch ein "Speichern unter" Dialog möglich?
Oder kann ich beim Pfad alternativ %userprofile%/Desktop angeben?
Wobei mir speichern unter lieber wäre (falls es ein Mac ist).

[derHoepp]

Moin,

naja, 52 mal kopieren ist ja nun keine große Herausforderung. Die folgende Datei habe ich in fünf Minuten erstellt.

Viele Grüße
derHöpp

[ipod86]

Natürlich geht das. 
Hab aber 5 Kitas.

Und ich weiß wie die ticken. Da wird regelmäßig was geändert. Zeilenhöhen, Logos, Text etc. 
Da ist es automatisiert einfach komfortabler. 

Wenn @Kuwer mir noch einen Tip zu meiner Frage gibt, bin ich wunschlos Glücklich.

[Kuwer]

Hallo,

hier mit Dialog:

Code:

Sub ExportZuPDF()
  Dim i As Long
  Dim strDatei As String
  Dim wbAktuell As Workbook
  Dim wbTemp As Workbook
  Set wbAktuell = ActiveWorkbook
  Application.ScreenUpdating = False
  With wbAktuell
    For i = .Worksheets("Einstellungen").Range("C3").Value To .Worksheets("Einstellungen").Range("C4").Value
        .Worksheets("Kalender").Range("H20") = i
        If wbTemp Is Nothing Then
          .Worksheets("Kalender").Copy
          Set wbTemp = ActiveWorkbook
        Else
          .Worksheets("Kalender").Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
        End If
        ActiveSheet.PageSetup.Orientation = xlLandscape
    Next i
  End With
  strDatei = Application.GetSaveAsFilename(, "PDF-Dateien (*.pdf), *.pdf")
  If Not CVar(strDatei) = False Then
    With wbTemp
      .ExportAsFixedFormat Type:=xlTypePDF, _
                       Filename:=strDatei, _
                        Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=True
      .Close False
    End With
  End If
  Application.ScreenUpdating = True
End Sub

Soll die PDF-Datei nicht anschließend geöffnet werden, muss
OpenAfterPublish:=True
zu
OpenAfterPublish:=False
geändert werden.

Gruß Uwe

---

Korrektur (Der Dialog war falsch eingebunden):

Code:

Sub ExportZuPDF()
  Dim i As Long
  Dim strDatei As String
  Dim wbAktuell As Workbook
  Dim wbTemp As Workbook
  Set wbAktuell = ActiveWorkbook
  Application.ScreenUpdating = False
  With wbAktuell
    For i = .Worksheets("Einstellungen").Range("C3").Value To .Worksheets("Einstellungen").Range("C4").Value
        .Worksheets("Kalender").Range("H20") = i
        If wbTemp Is Nothing Then
          .Worksheets("Kalender").Copy
          Set wbTemp = ActiveWorkbook
        Else
          .Worksheets("Kalender").Copy After:=wbTemp.Sheets(wbTemp.Sheets.Count)
        End If
        ActiveSheet.PageSetup.Orientation = xlLandscape
    Next i
  End With
  strDatei = Application.GetSaveAsFilename(, "PDF-Dateien (*.pdf), *.pdf")
  With wbTemp
    If Not CVar(strDatei) = False Then
      .ExportAsFixedFormat Type:=xlTypePDF, _
                       Filename:=strDatei, _
                        Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=True
    End If
    .Close False
  End With
  Application.ScreenUpdating = True
End Sub

Gruß Uwe