Printen van enkel de paginas met een inhoud

[Bjorkie]

Hey Allen,
in bijlage mijn file.
ik heb tot nu toe al veel hulp van jullie bekomen, maar heb nog eventjes wat assistentie nodig.
in mijn voorbeeld bestand, heb ik op elke 'oranje' sheets, een knop om af te drukken als PDF.
tot hier alles redelijk ok.
nu wil ik hier nog een variabel bereik aan toe kennen.
zoals op:
sheet1: enkel het bereik dat zichtbaar gemaakt is, met als afsluiter de rijen 125 & 126.

op sheet 3 (camera list) wil ik enkel deze paginas (of rijen) afdrukken waar er in kolom C of D een tekst staat

op sheet 4: enkel deze pagina's waar ook waarden in kolom A staan.

ik weet dat het vermoedelijk veel is dat ik vraag, maar ik ga ervan uit dat jullie hier misschien een eenvoudiger systeem voor hebben, dan al mijn afzonderlijke modules die ik momenteel werkende heb.

Bekijk bijlage camera oefening v2.6 - Test.xlsm

 

[Bjorkie]

Hey allen, ik heb al iets voor elkaar gekregen.
volgende vba code geeft mij het bereik dat aktief is.

Sub Print_Calculation()
    
    Const START_CEL As String = "A4"    'de startcel van het afdrukbereik
    Const ZOEK_CEL As String = "D6"     'de cel met de zoekwaarde
    
    Dim zoekGebied As Excel.Range       'het zoekgebied voor het tellen van zoekwaarde
    Dim zoekWaarde As String            'de zoekwaarde voor grootte afdrukbereik
    Dim aantalGevonden As Long          'het aantal keer dan zoekwaarde voorkomt
    
    Dim afdrukBereik As String          'het te bepalen afdrukbereik
    Dim afdrukRijen As Long             'het aantal rijen op het afdrukbereik
    Dim afdrukKolommen As Long          'het aantal kolommen op het afdrukbereik

    'Het zoekgebied instellen
    Set zoekGebied = Range("D4:D130")
    'de zoekwaarde is de waarde van de zoekcel
    zoekWaarde = Range(ZOEK_CEL)
    'het aantal gevonden rijen
    aantalGevonden = WorksheetFunction.CountIf(zoekGebied, zoekWaarde)
    
    'de hoogte van het afdrukbereik = 5 rijen per gevonden waarde
    afdrukRijen = aantalGevonden * 5
    '26 kolommen breed
    afdrukKolommen = 26
    
    If afdrukRijen > 0 Then
        
        'er zijn meer dan 0 afdrukrijen
        afdrukBereik = Range(START_CEL).Resize(afdrukRijen, afdrukKolommen).Address
        'het afdrukbereik bepalen:
        ActiveSheet.PageSetup.PrintArea = afdrukBereik
'Print Calculation page
    ActiveSheet.ExportAsFixedFormat 0, Application.GetSaveAsFilename(InitialName, "PDF Files (*.pdf), *.pdf")
    Sheets("Calculation").Select
    
    Else
        '0 rijen, gebruiker laten weten dat er niets gebeurd is
        MsgBox "Het afdrukbereik kan niet worden bepaald!", vbInformation

    End If

    'naam zoekgebied uit geheugen halen
    Set zoekGebied = Nothing

End Sub

probleem hier: ik bekom enkel de rijen, waarbij de waarde van cel D6 hetzelfde is aan de eerste.
ik moet hier dus bekomen dat ik alle rijen bkom, waar de waarde in kolom D>0

verder, heb ik nog het probleem dat de laatste rijen niet automatisch onderaan toegevoegd worden (rijen 125 & 126)
deze 2 rijen zouden altijd de pagina moeten afsluiten.

 

[Bjorkie]

Hey allen, ik heb al iets voor elkaar gekregen.
volgende vba code geeft mij het bereik dat aktief is.

Sub Print_Calculation()
    
    Const START_CEL As String = "A4"    'de startcel van het afdrukbereik
    Const ZOEK_CEL As String = "D6"     'de cel met de zoekwaarde
    
    Dim zoekGebied As Excel.Range       'het zoekgebied voor het tellen van zoekwaarde
    Dim zoekWaarde As String            'de zoekwaarde voor grootte afdrukbereik
    Dim aantalGevonden As Long          'het aantal keer dan zoekwaarde voorkomt
    
    Dim afdrukBereik As String          'het te bepalen afdrukbereik
    Dim afdrukRijen As Long             'het aantal rijen op het afdrukbereik
    Dim afdrukKolommen As Long          'het aantal kolommen op het afdrukbereik

    'Het zoekgebied instellen
    Set zoekGebied = Range("D4:D130")
    'de zoekwaarde is de waarde van de zoekcel
    zoekWaarde = Range(ZOEK_CEL)
    'het aantal gevonden rijen
    aantalGevonden = WorksheetFunction.CountIf(zoekGebied, zoekWaarde)
    
    'de hoogte van het afdrukbereik = 5 rijen per gevonden waarde
    afdrukRijen = aantalGevonden * 5
    '26 kolommen breed
    afdrukKolommen = 26
    
    If afdrukRijen > 0 Then
        
        'er zijn meer dan 0 afdrukrijen
        afdrukBereik = Range(START_CEL).Resize(afdrukRijen, afdrukKolommen).Address
        'het afdrukbereik bepalen:
        ActiveSheet.PageSetup.PrintArea = afdrukBereik
'Print Calculation page
    ActiveSheet.ExportAsFixedFormat 0, Application.GetSaveAsFilename(InitialName, "PDF Files (*.pdf), *.pdf")
    Sheets("Calculation").Select
    
    Else
        '0 rijen, gebruiker laten weten dat er niets gebeurd is
        MsgBox "Het afdrukbereik kan niet worden bepaald!", vbInformation

    End If

    'naam zoekgebied uit geheugen halen
    Set zoekGebied = Nothing

End Sub

probleem hier: ik bekom enkel de rijen, waarbij de waarde van cel D6 hetzelfde is aan de eerste.
ik moet hier dus bekomen dat ik alle rijen bkom, waar de waarde in kolom D>0

verder, heb ik nog het probleem dat de laatste rijen niet automatisch onderaan toegevoegd worden (rijen 125 & 126)
deze 2 rijen zouden altijd de pagina moeten afsluiten.

bedankt Mark xl voor deze voorgaande info. heb dit script uit een vroegere oplossing van jou bekomen (Dynamisch afdrukbereik)

 

[Bjorkie]

Oplossing voor page Calculation

Sub Print_Calculation()
'script to print only the Visible lines. with pagebreak condition after line 65 if more is visible
    Dim pb, i As Integer
    pb = Array(65)
    With ActiveSheet

    .ResetAllPageBreaks ' remove all page breaks from
    .PageSetup.PrintArea = "$B$4:$Z$128"
    .PageSetup.FitToPagesWide = 1
    .PageSetup.Zoom = 49
    .PageSetup.Orientation = xlLandscape
    For i = LBound(pb) To UBound(pb)
   
        If .Rows(pb(i)).Hidden = True Then
        .HPageBreaks.Add Before:=.Cells(129, 1)
        Else
        .HPageBreaks.Add Before:=.Cells(pb(i), 1)
        .HPageBreaks.Add Before:=.Cells(65, 1)
        End If
    Next i
End With
'Print Calculation page
    ActiveSheet.ExportAsFixedFormat 0, Application.GetSaveAsFilename(InitialName, "PDF Files (*.pdf), *.pdf")
    Sheets("Calculation").Select
End Sub

hiervoor heb ik volgende oplossing gevonden.
nu resten mijn nog die andere.
enige hulp is handig ;-)