Folgende Situation: Ich habe ein Exceldatei mit 20 Blätter, die verschiedene Namen tragen und von Excel zu Excel varieren (verschiedene Schülernamen in unterschiedlichen Klassen). Die Arbeitblätter stellen Resultate von Lernenden dar, die doppelseitig ausgedruckt werden können.
Nun soll per Button ein VBA-Skipt ausgelöst werden, der nur die jeweils die erste Seite der Resultate ausdruckt. D.h. der VBA müsste zuerst alle Namen der Worksheets auslesen, dann alles zusammen einzel ausdrucken.
Konkret am Beispiel: Das Worksheet "Klassenliste" muss zuerst ausgedruckt werden, dann nur den oberen Teil (blau,+ rosa) des Worksheets "1" (nur Produkt und Prozess) von allen eingetragenen Lerndenden. Leere Papierausdrucke sollten nicht entstehen.
Danke für ein Feedback
![[Bild: screenshot-2.jpg]](https://i.ibb.co/HHVVVKX/screenshot-2.jpg)
![[Bild: screenshot-1.jpg]](https://i.ibb.co/nLP9Kkh/screenshot-1.jpg)
Ich hab da mal was vorbereitet. Den Button mußt du aber selber einfügen. Es wird hier ein pdf erstellt und geöffnet wenn es fertig ist. Ich nutze bei den Seiten den Druckbereich, um die erste Seite zu erhalten. Probiers mal aus.
Code:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim strSheets As String
strSheets = "Klassenliste"
Application.PrintCommunication = True
With Worksheets("Klassenliste").PageSetup
.PrintArea = "A1:R60"
.FitToPagesWide = 1
.FitToPagesTall = 1
Application.PrintCommunication = False
' ActiveSheet.PrintOut From:=1, To:=1, Preview:=False, IgnorePrintAreas:=False
End With
For Each ws In Worksheets
If ws.Name <> "Klassenliste" Then
If ws.Range("B3").Value <> 0 Then
strSheets = strSheets & ";" & ws.Name
Application.PrintCommunication = True
ws.PageSetup.PrintArea = "A1:G45"
Application.PrintCommunication = False
' ActiveSheet.PrintOut From:=1, To:=1, Preview:=False, IgnorePrintAreas:=False
End If
End If
Next ws
Worksheets(Split(strSheets, ";")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & "Liste", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Worksheets("Klassenliste").Select
End Sub
Super! Herzlichen Dank.
Konnte es noch nicht ausprobieren, da ich nicht weiss wie man einen neuen zusätzlichen Makro hinzufügt zu einem bestehenden.
Wie geht das?
![[Bild: screenshot-3.jpg]](https://i.ibb.co/2cF9WNG/screenshot-3.jpg)
Sorry für meine Unkenntnisse.
Für deine Unkenntnis mußt du dich nicht entschuldigen, sondern nur etwas dagegen unternehmen.
Entwicklertools Einfügen ActiveXsteuerlemente Befehlsschaltfläche
Entwurfsmodus anklicken, rechte Maustaste auf Eingefügten Button Code anzeigen dort den Code einfügen ohne die Kopf und Fußzeile ,weil die schon drin stehen.
Bitte nur hier im Thread schreiben. Auf PN antworte ich nicht mehr.
es werden nur die Blätter gewählt ,in deren Zelle B3 ein Wert größer 0 steht und die Klassenliste. Bei meinen Tests hat das funktioniert. Was bei deiner Datei nicht funktioniert kann ich nicht beurteilen.