VBA-Sript Teile aus Seiten Drucken

[Miguel]

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

[ralf_b]

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

[Miguel]

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?



Sorry für meine Unkenntnisse.

[ralf_b]

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.

[ralf_b]

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.