automatisch pagina einde

Ridegroot · 25 mei 2016

In mijn voorbeeld heb ik niks ingesteld qua pagina einde en doorkruist deze op een gegeven moment na (automatisch via b7) rijen invoegen (zie voorbeeld) een tabel
Graag zou ik zien dat in een dergelijke situatie de gehele (2e) tabel automatisch naar de 2e pagina gaat.

Weet iemand of dit mogelijk is?

Wederom alvast bedanktBekijk bijlage Voorbeeld 3.xlsm

Peter B · 27 mei 2016

Als je de code op Blad1 (STELPOSTEN) vervangt voor de volgende code dan zou het moeten werken. Ik vind de oplossing nog niet helemaal netjes, en bij de eerste keer een regel invoeren reageert het systeem niet direct (vind ik storend) maar misschien kun je er iets mee. Ik ga er overigens van uit dat de sheet op het moment van starten minder regels bevat dan er op 1 blad passen:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet

If Target.Count <> 1 Then Exit Sub
If Intersect(Target, Columns(2)) Is Nothing Then Exit Sub
If Target.Row = 1 Then Exit Sub

If Target.Offset(-1).Interior.Color = rgbYellow Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With Target.EntireRow
        .Copy
        .Insert Shift:=xlDown
        .Offset(-1).Resize(, 2).ClearContents
    End With
    Target.Offset(, 1).Select
    
    Set ws = ActiveWorkbook.Sheets("STELPOSTEN")
    
    ActiveWindow.View = xlPageBreakPreview

    With ws.HPageBreaks
        If .Count > 0 Then
            If .Item(1).Location.Row < ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 2 _
                And .Item(1).Location.Row > 60 Then
                .Add Before:=Range("F44")
            End If
        Else
            .Add Before:=Range("F" & ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 2)
        End If
    End With
    
    ActiveWindow.View = xlNormalView

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Succes!

Ridegroot · 29 mei 2016

Bedankt voor de reactie echter krijg ik het nog niet werkend.

Zodra een tabel buiten het pagina bereik komt moet deze automatisch volledig naar een volgende pagina verspringen (zie voorbeelden + ctl P).

Welke excel expert kan dit voor elkaar krijgen?

succes en alvast bedankt

Peter B · 30 mei 2016

Hmmm. Je eerste voorbeeld wijkt af van je tweede voorbeeld. Ik ben dus (o.a.) uit gegaan van 2 tabellen. Ik heb nu o.b.v. "Voorbeeld 3 JUIST" een nieuw stukje code in elkaar gedraaid. Ik heb hem niet uitgebreid kunnen testen, want de nieuwe situatie is net iets lastiger. Laat maar weten of het voldoet ...

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim rowTblStart As Long
Dim rowTblSubtotaal As Long
Dim rowNextPageBreak As Long
Dim rowMax As Long
Dim iPageBreak As Long
Dim rowSelect As Long

If Target.Count <> 1 Then Exit Sub
If Intersect(Target, Columns(2)) Is Nothing Then Exit Sub
If Target.Row = 1 Then Exit Sub

If Target.Offset(-1).Interior.Color = rgbYellow Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With Target.EntireRow
        .Copy
        .Insert Shift:=xlDown
        .Offset(-1).Resize(, 2).ClearContents
    End With
    rowSelect = Target.Row
    
    Set ws = ActiveWorkbook.Sheets("STELPOSTEN")

    ActiveWindow.View = xlPageBreakPreview
' Alle pagebreaks verwijderen
    ActiveSheet.ResetAllPageBreaks
        
' Bepalen van de variabelen
    rowMax = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 2
    rowTblSubtotaal = 0
    If ws.HPageBreaks.Count > 0 Then
        iPageBreak = 1
    Else
        iPageBreak = 0
    End If

    While rowTblSubtotaal + 2 < rowMax
        rowTblSubtotaal = Cells.Find(What:="SUBTOTAAL", After:=ActiveCell, _
            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Row + 1
    
        With ws.HPageBreaks
            If iPageBreak <= .Count Then
                rowNextPageBreak = .Item(iPageBreak).Location.Row
            
                Cells(rowTblSubtotaal, "F").Activate
                If ActiveCell.Row > ws.HPageBreaks.Item(iPageBreak).Location.Row Then
                    rowTblStart = Cells.Find(What:="KOSTPRIJS", After:=ActiveCell, _
                        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, MatchCase:=True, SearchFormat:=False).Row
                    ws.HPageBreaks.Add before:=Cells(rowTblStart - 1, "F")
                    iPageBreak = iPageBreak + 1
                End If
            
            End If
        End With
    Wend

    ActiveWindow.View = xlNormalView

    Cells(rowSelect, "C").Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Ridegroot · 30 mei 2016

Mooie oplossing

Beste Peter B

Allereerst mijn complimenten voor jou oplossingen en excuus voor mijn minder heldere uitleg. Het aantal tabellen varieert (laten we zeggen tussen 1 en 10) deze voeg ik handmatig in en dit lijkt in jou versie ook nog te werken.

Ik heb jou sheet wel uitgebreid getest en er zitten nog een paar schoonheidsfoutjes in.

- Als ik regels verwijder en vervolgens weer invoeg dat krijg ik een foutmelding (fout 1)

- Het pagina einde komt net te laat (zie excel bijlage) (+ na een paar extra regels toevoegen)

- Bij te veel regels krijg ik ook een fout (er zit geen 2e pagina einde in denk ik) (zie fout 2)

Ik weet dat ik het erg moeilijk maak en begrijp het ook als het op een gegeven moment niet meer haalbaar is. Toch bedankt alvast

Bekijk bijlage Voorbeeld 3 ONJUIST-versie 2.xlsm

Ginger · 30 mei 2016

Het gebruik van het Change_Event lijkt mij persoonlijk hier volkomen misplaatst. Waarom zou je met iedere aanpassing van de sheet opnieuw alle Breaks gaan bepalen???
Lijkt mij beter om dit toe te passen in het BeforePrint_Event. Scheelt een hoop ellende.

Daarnaast snap ik niet waarom regel 1 en kolom A "straf" hebben gekregen en dus niet mee mogen doen. Begin dus met plakken van je tabellen in cel A1. Ook dat scheelt je veel gedoe met bepalen of iets past of niet én je kan je printrange veel simpeler instellen.
Vervolgens de vraag... Begint elke nieuwe tabel met het woord "STELPOST"? Of kan die tabelheader vele titels hebben? In het eerste geval zou je dus de code regel voor regel laten kunnen laten zoeken naar dat woord en zo je bereiken bepalen. Komt wel gelijk de vervolgvraag bij me op wat je gaat doen als je tabel langer blijkt dan die 60 regels. Mag het dan wél ineens op 2 of meer pagina's?

Al met al niet heel makkelijk om dit goed te automatiseren.

Peter B · 31 mei 2016

Kijk. En zo leer ik dus ook weer ... Ik kende het BeforePrint_Event helemaal niet. Dat is inderdaad veel logischer.

Er zitten naast de aangegeven punten van Ginger nog wel een ander "vervelend" ding in. Samengevoegde cellen ... Ik heb het vermoeden dat dit de oorzaak is van de tweede fout die je tegen komt. In de derde fout (fout 2) loop je inderdaad aan tegen de "beperking" dat een tabel niet meer dan één pagina lang mag zijn. Hierin voorziet mijn code idd. niet. Fout 1 zal ik naar kijken.

Peter B · 31 mei 2016

Volgens mij zijn de eerste en de tweede fout opgelost met onderstaande code. Voor het testen heb ik hem in de Change_Event laten staan. Beter is om 'm, na het testen, los te trekken zoals Ginger aangeeft.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet
Dim rowTblStart As Long
Dim rowTblSubtotaal As Long
Dim rowNextPageBreak As Long
Dim rowMax As Long
Dim iPageBreak As Long
Dim rowSelect As Long

If Target.Count <> 1 Then Exit Sub
If Intersect(Target, Columns(2)) Is Nothing Then Exit Sub
If Target.Row = 1 Then Exit Sub

If Target.Offset(-1).Interior.Color = rgbYellow Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    With Target.EntireRow
        .Copy
        .Insert Shift:=xlDown
        .Offset(-1).Resize(, 2).ClearContents
    End With
    rowSelect = Target.Row
    
    Set ws = ActiveWorkbook.Sheets("STELPOSTEN")

    ActiveWindow.View = xlPageBreakPreview
' Alle pagebreaks verwijderen
    ActiveSheet.ResetAllPageBreaks
        
' Bepalen van de variabelen
    rowMax = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row + 2
    rowTblSubtotaal = 0
    If ws.HPageBreaks.Count > 0 Then
        iPageBreak = 1
        While rowTblSubtotaal + 2 < rowMax
            rowTblSubtotaal = Cells.Find(What:="SUBTOTAAL", After:=ActiveCell, _
                LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Row + 3
        
            With ws.HPageBreaks
                If iPageBreak <= .Count Then
                    rowNextPageBreak = .Item(iPageBreak).Location.Row
                
                    Cells(rowTblSubtotaal, "F").Activate
                    If ActiveCell.Row > ws.HPageBreaks.Item(iPageBreak).Location.Row Then
                        rowTblStart = Cells.Find(What:="KOSTPRIJS", After:=ActiveCell, _
                            LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, MatchCase:=True, SearchFormat:=False).Row
                        ws.HPageBreaks.Add before:=Cells(rowTblStart - 1, "F")
                        iPageBreak = iPageBreak + 1
                    End If
                
                End If
            End With
        Wend
    End If

    ActiveWindow.View = xlNormalView

    Cells(rowSelect, "C").Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End If
End Sub

Als die tabel over meerdere pagina's een probleem is moet je het maar aangeven. Dan wil ik daar nog wel over nadenken.

Ridegroot · 31 mei 2016

Goede Avond

Weer enorm bedankt voor de oplossingen ik denk dat we er echt bijna zijn.

Opmerking A: Er mist een enter boven aan de tabel op een volgende pagina (zie bijlage en/of excel sheet laatste pagina)

Opmerking B: In een extreem geval qua tabel aantallen (zie excel sheet) werkt ie niet bij elke tabel goed.

Zou iemand nog één keer willen kijken?

Wederom alvast bedankt en fijne avondBekijk bijlage Voorbeeld 3 ONJUIST-versie 3.xlsm

Peter B · 31 mei 2016

Voor opmerking A kun je de volgende regel vervangen:

Code:

ws.HPageBreaks.Add before:=Cells(rowTblStart - 1, "F")

voor

Code:

ws.HPageBreaks.Add before:=Cells(rowTblStart - 2, "F")

V.w.b. opmerking B heb ik geen oplossing voor handen. Wellicht één van de andere liefhebbers wel?

Ridegroot · 9 jun 2016

Peter B hartelijk dank voor je reactie. Misschien iemand anders nog een geniale ingeving voor opmerking B? (misschien kan het probleem op een compleet andere manier worden opgelost)

automatisch pagina einde

Ridegroot

Gebruiker

Peter B

Gebruiker

Ridegroot

Gebruiker

Bijlagen

Peter B

Gebruiker

Ridegroot

Gebruiker

Ginger

Terugkerende gebruiker

Peter B

Gebruiker

Peter B

Gebruiker

Ridegroot

Gebruiker

Peter B

Gebruiker

Ridegroot

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy