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?
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
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).
[
attachment=45501]
Edit:
Auf der Seite "Einstellungen" können die gewünschten KWs und as Jahr eingestellt werden.
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.
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?
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
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).
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
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.
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