Print meerdere sheets op basis van cel waarde

[rbloeme]

Ik probeer meerdere sheets te printen op basis van cel waarde. ik heb onderstaande gemaakt maar dat functioneert niet



Sub PrintAll()
Keuze = MsgBox("Are you sure you want to print ALL worksheets ?", vbQuestion + vbYesNo, "PRINT ALL !")
Select Case Keuze
Case vbYes
For Each sh In ThisWorkbook.Sheets
If sh.Name Like "BGD#*" Then
If sh.Range("BY3") = "1" Then
myPrtArea = "E1:AX66"
Sheets(sh).PageSetup.PrintArea = myPrtArea
Sheets(sh).PrintOut
Sheets(sh).PrintArea = curPrtArea
End If
End If
If sh.Name Like "BGD#*" Then
If sh.Range("BY4") = "2" Then
myPrtArea = "E141:AX207"
Sheets(sh).PageSetup.PrintArea = myPrtArea
Sheets(sh).PrintOut
Sheets(sh).PageSetup.PrintArea = curPrtArea
End If
End If
Next sh
Case vbNo
' do nothing
End Select
End Sub

 

[Timshel]

Met de overbodige reut eruit en de code tussen tags geplaatst ziet het er al een stuk beter uit.
Misschien werkt het zelfs

Sub PrintAll()
    If MsgBox("Are you sure you want to print ALL worksheets ?", vbQuestion + vbYesNo, "PRINT ALL !") = vbYes Then
        For Each sh In ThisWorkbook.Sheets
            If sh.Name Like "BGD#*" Then
                sh.PageSetup.PrintArea = Choose(sh.Range("BY4") * 1, "E1:AX66", "E141:AX207")
                sh.PrintOut
            End If
        Next
    End If
End Sub

 

[rbloeme]

helaas,

hij kijkt niet naar de waarde van de cel en ook niet naar de printarea (maakt nieuwe pagina indeling en print 14 paginas uit

 

[Timshel]

Dan wordt het tijd om een representatief voorbeeldbestand te plaatsen.

 

[rbloeme]

voorbeeldbestand

 

[Timshel]

Probeer het hier eens mee

Sub PrintAll()
    Dim Sh As Object
    
    If MsgBox("Are you sure you want to print ALL worksheets ?", vbQuestion + vbYesNo, "PRINT ALL !") = vbYes Then
        For Each Sh In ThisWorkbook.Sheets
            If Sh.Name Like "BGD#*" And Sh.Range("BY4") > 0 Then
                Sh.PageSetup.PrintArea = Choose(Sh.Range("BY4"), "E1:AX66", "E141:AX207")
                Sh.PrintOut
            End If
        Next
    End If
End Sub

 

[rbloeme]

dat functioneert al een stuk in beter in de goeie richting
hij print alleen het eerste afdrukbereik af, maar bij het twee afdrukbereik moet ook eerst naar een andere cel waarde gekeken worden

ik heb het geprobeerd te veranderen in onderstaande, maar dat werkt niet


Sub PrintAll()
Dim Sh As Object

If MsgBox("Are you sure you want to print ALL worksheets ?", vbQuestion + vbYesNo, "PRINT ALL !") = vbYes Then
For Each Sh In ThisWorkbook.Sheets
If Sh.Name Like "BGD#*" And Sh.Range("BY4,BY5") > 0 Then
Sh.PageSetup.PrintArea = Choose(Sh.Range("BY4"), "E1:AX66")
Sh.PageSetup.PrintArea = Choose(Sh.Range("BY5"), "E141:AX207")
Sh.PrintOut
End If
Next
End If
End Sub

 

[Timshel]

hij print alleen het eerste afdrukbereik af, maar bij het twee afdrukbereik moet ook eerst naar een andere cel waarde gekeken worden

Snap niet wat je bedoelt.
Gebruik graag codetags voor programmatekst: https://www.helpmij.nl/forum/announcement.php?f=5

 

[rbloeme]

het eerste afdrukbereik E1:AX66 moet worden geprint als BY4 >0
het twede afdrukbereik E141:AX207 moet worden geprint als BY5 >0

 

[Timshel]

De grootste uitdaging is vaak niet het programmeren zelf maar duidelijk krijgen wat de bedoeling is

Sub PrintAll()
    Dim Sh As Object
    Dim i As Long
    
    If MsgBox("Are you sure you want to print ALL worksheets ?", vbQuestion + vbYesNo, "PRINT ALL !") = vbYes Then
        For Each Sh In ThisWorkbook.Sheets
            If Sh.Name Like "BGD#*" Then
                For i = 1 To 2
                    If Sh.Range("BY3").Offset(i) = i Then
                        Sh.PageSetup.PrintArea = Choose(i, "E1:AX66", "E141:AX207")
                        Sh.PrintOut
                    End If
                Next
            End If
        Next
    End If
End Sub

 

[rbloeme]

Helaas met deze code gebeurt er niks, maar ik hou het wel bij de eerste want het komt toch maar weinig voor dat het tweede afdruk bereik moet worden uitgeprint

 

[rbloeme]

het is gelukt om met de eerste code beide afdruk bereiken te gebruiken

                For Each Sh In ThisWorkbook.Sheets
                    If Sh.Name Like "BGD#*" And Sh.Range("BY4") > 0 Then
                        Sh.PageSetup.PrintArea = Choose(Sh.Range("BY4"), "E1:AX66")
                        Sh.PrintOut
                    End If
                    If Sh.Name Like "BGD#*" And Sh.Range("BY5") > 0 Then
                        Sh.PageSetup.PrintArea = Choose(Sh.Range("BY5"), "E141:AX207")
                        Sh.PrintOut
                    End If

 

[HSV]

De 'choose' heeft zo geen zin natuurlijk.