Thema: VBA - Seite nicht Drucken wenn bestimmte Zelle 0

Hallo zusammen,

ich habe eine simple VBA Funktion und möchte diese erweitern... Beispiel: ich habe 3 Tabellen Seiten und die sollen per VBA gedruckt werden, wenn aber Tabelle 2 Zelle A1 den Wert 0 hat soll nur Tabelle 1 und 3 gedruckt werden, wenn Tabelle 2 Zelle A1 einen Wert drinnen hat der größer als 0 ist dann soll er Tabelle 1,2 und 3 drucken.

Kann mir jemand helfen ?

Das ist mein VBA

Sub TEST()
'
' TEST Makro
'

'
Sheets(Array("Tabelle1", _
"Tabelle2", _
"Tabelle3")).Select
Sheets("Tabelle1").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub


Danke im voraus

Hi Tobias1989

Versuche es damit:

Sub TEST()

    Dim printSheets As Variant

    

    ' Überprüfen des Werts in Zelle A1 von Tabelle2

    If Sheets("Tabelle2").Range("A1").Value > 0 Then

        ' Wenn der Wert größer als 0 ist, drucke alle 3 Tabellen

        printSheets = Array("Tabelle1", "Tabelle2", "Tabelle3")

    Else

        ' Wenn der Wert 0 ist, drucke nur Tabelle 1 und Tabelle 3

        printSheets = Array("Tabelle1", "Tabelle3")

    End If

    

    ' Drucke die ausgewählten Tabellen

    Sheets(printSheets).Select

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

Gruss

Raimund

Moin zusammen,

Gedankenspiel als Erweiterung von Raimunds Lösung: drucke jedes Blatt dessen Zelle A1 > 0

Sub DruckeWennA1NichtNull()

Dim Bzd ' Blatt zu drucken

Dim W

    

    Bzd = Array()

' Überprüfen des Werts in Zelle A1 von Tabelle2

    For Each W In Array("Tabelle1", "Tabelle2", "Tabelle3")

        If Worksheets(W).Range("A1").Value > 0 Then

            ReDim Preserve Bzd(UBound(Bzd) + 1)

            Bzd(UBound(Bzd)) = W

        End If

    Next

' Drucke die ausgewählten Tabellen

    If UBound(Bzd) > -1 Then Worksheets(Bzd).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

End Sub

Bei einem Standarddruck wäre es egal: man kann jedes Blatt einzeln drucken. Bei einem Druck in PDF müssen die Blätter als ein Druckauftrag gedruckt werden, sodass alles in einer Datei rauskommt.

VG
Yal

Hi Tobias1989

Versuche es damit:

Sub TESTspeichern()

    Dim printSheets As Variant

    Dim pdfFilePath As String

    

    ' Überprüfen des Werts in Zelle A1 von Tabelle2

    If Sheets("Tabelle2").Range("A1").Value > 0 Then

        ' Wenn der Wert größer als 0 ist, wähle alle 3 Tabellen

        printSheets = Array("Tabelle1", "Tabelle2", "Tabelle3")

    Else

        ' Wenn der Wert 0 ist, wähle nur Tabelle 1 und Tabelle 3

        printSheets = Array("Tabelle1", "Tabelle3")

    End If

    

    ' Aktiviere die erste Tabelle in der Liste

    Sheets(printSheets(0)).Select

    

    ' Definiere den Pfad für die PDF-Datei

    pdfFilePath = "C:\Users\ogmes-ap10\Desktop\test.pdf"

    

    ' Exportiere die ausgewählten Tabellen als PDF

    Sheets(printSheets).Select

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        pdfFilePath, Quality:=xlQualityStandard, _

        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

Gruss

Raimund

Hi Tobias1989

In deinem VBA-Code fehlen einige wichtige Punkte

Array-Deklaration:
Du hast Dim Bzd ohne Typangabe deklariert. Es sollte als dynamisches Array deklariert werden: Dim Bzd() As String.

Du hast ReDim Preserve Bzd(UBound(Bzd) + 1) verwendet, ohne sicherzustellen, dass Bzd tatsächlich initialisiert war. Du hast ReDim Preserve Bzd(UBound(Bzd) + 1) verwendet, ohne sicherzustellen, dass Bzd tatsächlich initialisiert war.

Die Variable W sollte als Variant deklariert werden, um korrekt mit dem Inhalt des Arrays zu arbeiten.

Versuche es so:

Sub DruckeWennA1NichtNull()

    Dim Bzd() As String ' Blatt zu drucken

    Dim W As Variant

    Dim BzdCount As Integer



    BzdCount = -1 ' Zähler für das Bzd-Array initialisieren

    ' Überprüfen des Werts in Zelle A1 der angegebenen Blätter

    For Each W In Array("Deckblatt", "Grundler VK-Auswertung", "GrAusfallermittlung vor Poolung")

        If Worksheets(W).Range("A1").Value > 0 Then

            BzdCount = BzdCount + 1

            ReDim Preserve Bzd(BzdCount) ' Array vergrößern

            Bzd(BzdCount) = W

        End If

    Next W

    

    ' Drucke die ausgewählten Tabellen

    If BzdCount > -1 Then

        Worksheets(Bzd).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

    End If

End Sub

Gruss

Raimund

Hallo Raimund,

Du hast recht mit der Erklärung der Initialisierung. Initialisiert ist es mit = Array(). Teste:

Sub test()

Dim Arr

    Arr = Array()

    MsgBox UBound(Arr)

    ReDim Preserve Arr(UBound(Arr)+1)

    MsgBox UBound(Arr)

End Sub

Typisierung ist auch richtig und zu bevorzugen, aber wir gehen nicht davon aus, dass es hier um ein hochrelevante Datensystem handelt. Ein paar Programmierungsschlampereien zum Gunsten eines kürzeren Code kann man sich gönnen ;-)

VG
Yal

Erstmal wieder dickes Danke aber wäre es möglich (Ihr seht ja wie viele Tabellen bzw. Reiter es gibt) zu sagen

Druck alle die auf A1 größer als 0 sind?

Dann würde ich über all das oben so machen das praktisch alle Seiten die ich nicht brauche automatische eine 0 haben und die anderen einen Wert größer als 0

Danke

Moin!
Na, das ist doch ganz einfach:

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

   If ws.Range("A1") > 0 Then ws.PrintOut

End With

Gruß Ralf

Hi Tobias1989

So?

Sub DruckeWennA1NichtNull()

    Dim ws As Worksheet

    Dim Bzd() As String ' Array für die Blätter, die gedruckt werden sollen

    Dim BzdCount As Integer



    BzdCount = -1 ' Zähler für das Bzd-Array initialisieren



    ' Durchlaufe alle sichtbaren Blätter

    For Each ws In ThisWorkbook.Worksheets

        If ws.Visible = xlSheetVisible Then

            ' Überprüfen des Werts in Zelle A1 des aktuellen Blattes

            If ws.Range("A1").Value > 0 Then

                BzdCount = BzdCount + 1

                ReDim Preserve Bzd(BzdCount) ' Array vergrößern

                Bzd(BzdCount) = ws.Name ' Blattname speichern

            End If

        End If

    Next ws

    

    ' Drucke die ausgewählten Tabellen

    If BzdCount > -1 Then

        Worksheets(Bzd).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

    End If

End Sub

Gruss

Raimund

@Raimund du bist genial, ihr alle seit sehr gut Danke an alle... Könntet ihr mir das gleiche nur für speichern als pdf machen ? Sprich alle Seiten Speichern die A1 größer wie 0 sind ?

Danke

Hallo Tobias,

eigentlich brauchst Du nur die verschiedene Teilstücke miteinander zu kombinieren. Diese Auseinandersetzung ist auch notwendig, um deine Programmierfähigkeit zu stärken und deine Abhängigkeit zu reduzieren. Du willst ja nicht dein Leben lang "VBA nur mit Recorder" bleiben.

Aber falls Du nicht selber drauf kommst:

Sub DruckeWennA1NichtNull()

    Dim ws As Worksheet

    Dim Bzd() As String ' Array für die Blätter, die gedruckt werden sollen

    Dim BzdCount As Integer



    BzdCount = -1 ' Zähler für das Bzd-Array initialisieren



' Durchlaufe alle sichtbaren Blätter

    For Each ws In ThisWorkbook.Worksheets

        If ws.Visible = xlSheetVisible Then

        ' Überprüfen des Werts in Zelle A1 des aktuellen Blattes

            If ws.Range("A1").Value > 0 Then

                BzdCount = BzdCount + 1

                ReDim Preserve Bzd(BzdCount) ' Array vergrößern

                Bzd(BzdCount) = ws.Name ' Blattname speichern

            End If

        End If

    Next ws

    

' Exportiere die ausgewählten Tabellen als PDF

    If BzdCount > -1 Then

    Worksheets(Bzd).ExportAsFixedFormat Type:=xlTypePDF, _

        Filename:="C:\Users\ogmes-ap10\Desktop\test.pdf", _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=False, OpenAfterPublish:=True

    End If

End Sub

VG
Yal

@YAL Guten Morgen, sorry hatte gestern schon Feierabend, ja ich würde natürlich gerne dazu lernen statt den Recorder zu nutzen, Danke das ihr mir helft. Jetzt habe ich es probiert aber da bleibt er hier hängen:

Worksheets(Bzd).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Users\ogmes-ap10\Desktop\test.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

Hi Tobias

so?
Alle Blätter mit Wert > 0 in Zelle A1 werden mit jeweiligen Blattnamen gespeichert und gedruckt.

Den Pfad musst Du ändern: pdfFilePath = "C:\Users\luxin\Downloads\" & Bzd(i) & ".pdf" ' Pfad mit Blattnamen

Sub DruckeUndSpeichereWennA1NichtNull()

    Dim ws As Worksheet

    Dim Bzd() As String ' Array für die Blätter, die gedruckt und gespeichert werden sollen

    Dim BzdCount As Integer

    Dim pdfFilePath As String

    Dim i As Integer



    BzdCount = -1 ' Zähler für das Bzd-Array initialisieren



    ' Durchlaufe alle sichtbaren Blätter

    For Each ws In ThisWorkbook.Worksheets

        If ws.Visible = xlSheetVisible Then

            ' Überprüfen des Werts in Zelle A1 des aktuellen Blattes

            If IsNumeric(ws.Range("A1").Value) And ws.Range("A1").Value > 0 Then

                BzdCount = BzdCount + 1

                ReDim Preserve Bzd(BzdCount) ' Array vergrößern

                Bzd(BzdCount) = ws.Name ' Blattname speichern

            End If

        End If

    Next ws



    ' Verarbeite die ausgewählten Tabellen

    If BzdCount > -1 Then

        For i = 0 To BzdCount

            ' Drucke das aktuelle Blatt

            Worksheets(Bzd(i)).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

            

            ' Speichere das aktuelle Blatt als PDF

            pdfFilePath = "C:\Users\luxin\Downloads\" & Bzd(i) & ".pdf" ' Pfad mit Blattnamen

            ThisWorkbook.Worksheets(Bzd(i)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

                pdfFilePath, Quality:=xlQualityStandard, _

                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Next i

    End If

End Sub

Gruss

Raimund

Funktioniert nicht ganz der speichert dann nur das letzte Blatt als PDF ab und nicht alle in einer PDF Datei

Hi Tobias

Bei mir werden alle sichtbaren Blätter mit wert > 0 in Zelle A1 unter C:\Users\luxin\Downloads gespeichert



Gruss

Raimund

Hi Tobias

Schwer zu sagen, wo der Fehler liegt, ohne deinen Script zu sehen

Gruss

Raimund

Hi Tobias

Es is richtig. Es werden alle Blätter einzeln gespeichert und nicht in einer einzigen PDF Datei

Gruss

Raimund

So jetzt konnte ich alles probieren und es klappt alles hervorragend, was für ein tolles Gefühl wenn das alles so reibungslos klappt, aber nur dank eurer Hilfe.

EIN RIESEN DANK AN EUCH BEIDEN @Raimund & @YAL macht weiter so, vielen Dank für eure Hilfe und eure Zeit.

Liebe Grüße

Gestern hast du mir einen Code geschickt der zum Drucken super funktioniert:

Sub DruckeWennA1NichtNull()
Dim ws As Worksheet
Dim Bzd() As String ' Array für die Blätter, die gedruckt werden sollen
Dim BzdCount As Integer

BzdCount = -1 ' Zähler für das Bzd-Array initialisieren

' Durchlaufe alle sichtbaren Blätter
For Each ws In ThisWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
' Überprüfen des Werts in Zelle A1 des aktuellen Blattes
If ws.Range("A1").Value > 0 Then
BzdCount = BzdCount + 1
ReDim Preserve Bzd(BzdCount) ' Array vergrößern
Bzd(BzdCount) = ws.Name ' Blattname speichern
End If
End If
Next ws

' Drucke die ausgewählten Tabellen
If BzdCount > -1 Then
Worksheets(Bzd).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End If
End Sub

Da druckt er zum Beispiel Seite 1 bis 6 (also er zählt die richtig auf)

Bei dem Code jetzt von eben druckt er zwar auch die 6 Seiten aber wie soll ich sagen der steuert die einzeln an Seite 1 von 1, 1 von 1 usw. bis er 6 Seiten hat. Und da ist auch wie du eben geschickt hast bei der PDF das Problem er macht einzelne Datein es sollte aber 6 Seiten in einer PDF sein.

Vielen Dank für deine Mühen und Zeit. :)

Hi Tobias

Teste das hier:

Pfad anpassen: pdfFilePath = "C:\Users\luxin\Downloads\Alle_Blaetter_Als_PDF.pdf

Sub DruckeUndSpeichereWennA1NichtNull()

    Dim ws As Worksheet

    Dim Bzd As Collection

    Dim pdfFilePath As String

    Dim i As Integer



    Set Bzd = New Collection ' Collection für die Blätter



    ' Durchlaufe alle sichtbaren Blätter

    For Each ws In ThisWorkbook.Worksheets

        If ws.Visible = xlSheetVisible Then

            ' Überprüfen des Werts in Zelle A1 des aktuellen Blattes

            If IsNumeric(ws.Range("A1").Value) And ws.Range("A1").Value > 0 Then

                Bzd.Add ws.Name ' Blattname zur Collection hinzufügen

            End If

        End If

    Next ws



    ' Überprüfen, ob Blätter gefunden wurden

    If Bzd.Count > 0 Then

        ' Definiere den Pfad für die PDF-Datei

        pdfFilePath = "C:\Users\luxin\Downloads\Alle_Blaetter_Als_PDF.pdf"



        ' Drucke die ausgewählten Blätter

        For i = 1 To Bzd.Count

            ThisWorkbook.Sheets(Bzd(i)).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

        Next i



        ' Exportiere die ausgewählten Blätter als PDF

        Dim SheetArray() As String

        ReDim SheetArray(1 To Bzd.Count)

        For i = 1 To Bzd.Count

            SheetArray(i) = Bzd(i) ' Fülle das Array mit den Blattnamen

        Next i



        ' Exportiere die Auswahl als PDF

        ThisWorkbook.Sheets(SheetArray).Select ' Wählen Sie alle passenden Blätter aus

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

            pdfFilePath, Quality:=xlQualityStandard, _

            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



        MsgBox "PDF wurde erfolgreich gespeichert.", vbInformation

    Else

        MsgBox "Keine Blätter zum Exportieren gefunden.", vbExclamation

    End If

End Sub

Gruss

Raimund

Hi Tobias

Das Problem mit der steuert die einzeln an Seite 1 von 1, 1 von 1 usw habe ich hoffentlich hier verbessert

Sub DruckeUndSpeichereWennA1NichtNull()

    Dim ws As Worksheet

    Dim Bzd As Collection

    Dim pdfFilePath As String

    Dim i As Integer



    Set Bzd = New Collection ' Collection für die Blätter



    ' Durchlaufe alle sichtbaren Blätter

    For Each ws In ThisWorkbook.Worksheets

        If ws.Visible = xlSheetVisible Then

            ' Überprüfen des Werts in Zelle A1 des aktuellen Blattes

            If IsNumeric(ws.Range("A1").Value) And ws.Range("A1").Value > 0 Then

                Bzd.Add ws.Name ' Blattname zur Collection hinzufügen

            End If

        End If

    Next ws



    ' Überprüfen, ob Blätter gefunden wurden

    If Bzd.Count > 0 Then

        ' Definiere den Pfad für die PDF-Datei

        pdfFilePath = "C:\Users\luxin\Downloads\Alle_BlaetterPDF.pdf"



        ' Exportiere die ausgewählten Blätter als PDF

        Dim SheetArray() As String

        ReDim SheetArray(1 To Bzd.Count)

        For i = 1 To Bzd.Count

            SheetArray(i) = Bzd(i) ' Fülle das Array mit den Blattnamen

        Next i



        ' Exportiere die Auswahl als PDF

        ThisWorkbook.Sheets(SheetArray).Select ' Wählen Sie alle passenden Blätter aus

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

            pdfFilePath, Quality:=xlQualityStandard, _

            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



        ' Drucke die ausgewählten Blätter

        ThisWorkbook.Sheets(SheetArray).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False



        MsgBox "PDF wurde erfolgreich gespeichert und Blätter wurden gedruckt.", vbInformation

    Else

        MsgBox "Keine Blätter zum Exportieren gefunden.", vbExclamation

    End If

End Sub

Gruss

Raimund

Achtung: die Unterschied zwischen "ActiveSheet" und "ActiveWindow.SelectedSheets" beachten

entweder:

    ' Exportiere die ausgewählten Tabellen als PDF

    Worksheets(printSheets).Select

    ActiveWindow.SelectedSheets.ExportAsFixedFormat Type:=xlTypePDF, _

        Filename:=pdfFilePath, _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=False, OpenAfterPublish:=True

oder

    ' Exportiere die ausgewählten Tabellen als PDF

    Worksheets(printSheets).ExportAsFixedFormat Type:=xlTypePDF, _

        Filename:=pdfFilePath, _

        Quality:=xlQualityStandard, IncludeDocProperties:=True, _

        IgnorePrintAreas:=False, OpenAfterPublish:=True

VG
Yal

Danke ihr seit echt super :) das klappt mega... eine Frage wenn ich das ganze genauso als PDF abspeichern will also unter den gleichen Voraussetzungen (Tabelle 2 Zelle A1 0 = gleich nicht mit drucken bzw. abspeichern) wie lautet dann der Code ?

Hier wieder ein Beipspiel:

Sub TESTspeichern()
'
' TESTspeichern Makro
'

'
Sheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Select
Sheets("Tabelle1").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\ogmes-ap10\Desktop\test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub

Danke

Also ich versteh nicht das es funktioniert bei einer Test Tabelle aber wenn ich es in meiner richtigen Tabelle anwenden möchte kommt ein fehler ?? Was mach ich falsch ?

Sub DruckeWennA1NichtNull()
Dim Bzd ' Blatt zu drucken
Dim W

Bzd = Array()
' Überprüfen des Werts in Zelle A1 von Grundler VK-Auswertung
For Each W In Array("Deckblatt", "Grundler VK-Auswertung", "GrAusfallermittlung vor Poolung")
If Worksheets(W).Range("A1").Value > 0 Then
ReDim Preserve Bzd(UBound(Bzd) + 1)
Bzd(UBound(Bzd)) = W
End If
Next
' Drucke die ausgewählten Tabellen
If UBound(Bzd) > -1 Then Worksheets(Bzd).PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub


hier ein Bild:


er hängt bei If Worksheets(W).Range("A1").Value > 0 Then

Hallo Tobias,

wenn man ganz weit reinzoomt... und genau schaut... sieht man, ...
dass der Klammer am Ende von Tabelle2 (Grundler VK-Auswertung )
mehr Abstand vom letzten Buchstaben als die anderen Blätternamen.

d.h. am Ende von "Grundler VK-Auswertung" gibt ein Leerzeichen.
Entweder korrigierst Du den Blattname (besser) oder andere den VBA-Code in "Grundler VK-Auswertung " (mit Leerzeichen, weniger gut).

Die genaue Lauterung der Fehlermeldung wäre auch gut gewesen. Ein Blick auf deinem Bildschirm haben wir nicht.

VG
Yal