Pagina-einde in kolom

[robinvdveeken]

Welgewaardeerde forum leden,

Doormiddel van diverse macro's genereer ik een flinke lijst met tabellen. Deze moet uiteindelijk worden uitgeprint.
De Pagebreaks (pagina-einden) welke automatisch worden bepaald gaan dwars door deze tabellen heen. Dit is niet de bedoeling. Als blijkt dat niet de hele tabel op de pagina past, dan moet de pagina-einde voor die tabel komen.

De vraag is, hoe kan ik hier voorwaarden aan geven?

Mijn idee gaat uit naar zoiets als:

xlPageBreakAutomatic.Borders.LineStyle = xlNone

Kan iemand mij helpen?

In de bijlage het bestand, met lege tabellen.

Alvast bedankt,

Groeten,
Robin

 

[Warme bakkertje]

Is het dan niet handiger om een page-layout te testen zodat er bv 3 tabellen op 1 blad passen en dan om de x-aantal lijnen (zoals het uitkomt) een PageBreak te plaatsen ?

Edit: Wordt moeilijk aangezien je tabellen niet allemaal dezelfde grootte hebben.

 

[Superzeeuw]

Er is een manier om dit bij benadering te kunnen bepalen.

Je kunt er vanuit gaan dat er ongeveer 55 regels op 1 pagina passen.
Met een loop kun je bepalen of iedere 55ste regel in de tabel zit, zo ja dan ga je terug tot het begin van je tabel en zet een pagebreak.
Nu tel je vanaf daar opnieuw 55 regels en doet dezelfde controle.

LET OP!
Het is indicatief, dit is geen garantie dat het 100% is.
Maar proberen levert meer op dan niets doen.

 

[robinvdveeken]

Helden,

Het is gelukt. Inderdaad een hele uitdaging om het "waterdicht" te krijgen.

Voor de volledigheid de code, verwerkt in een aparte sub:

Sub Paginaeinden()

'gemaakt door R. van der Veeken op 6-1-2011
'voegt de gegenereerde tabellen in

'declaratie
Dim Regel_nr As Integer 'Regel nummer op tabblad waarvan word gekopieerd
Dim empty_regel As Integer 'Aantal lege regels
Dim Blad_regel_nr As Integer 'Regel nummer op tabblad waarop word gekopieerd
Dim Kader_regel As Integer
Dim Bladregel As Integer
Dim Blad_regel_max As Integer
Dim Target As Range




Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

 're-init
Regel_nr = 0 'van huidig blad
empty_regel = 0 'aantal lege regels
Blad_regel_nr = 0
Regel = 0
empty_regel = 0
Kader_regel = 0
Blad_regel_max = 53 'aantal regels op een pagina
     
 ActiveSheet.HPageBreaks.Add Before:=Range("A1")
     
     While empty_regel < 4
                 
      
        If Range("A" & Regel) <> "" Or Range("B" & Regel) <> "" Then ' regel gevuld
           Range("AB" & Regel) = Kader_regel
           Kader_regel = Kader_regel + 1 'tel het kader regels
           
          
        Else
            Kader_regel = 0
       
        End If
                     
        If Range("A" & Regel) = "" And Range("B" & Regel) = "" Then 'regel is leeg
           
           empty_regel = empty_regel + 1 'tel het aantal lege regels
        Else
            empty_regel = 0
            
        End If
        
        Range("AC" & Regel) = empty_regel
        
        
        If Range("A" & Regel).Interior.ColorIndex = 15 Then
        
        ActiveSheet.HPageBreaks.Add Before:=Range("A" & Regel - 2)
        
        empty_regel = 0
        Blad_regel = 0
        Kader_regel = 0
        Regel_nr = 4
        
        End If
        
        
        
        If Regel_nr > Blad_regel_max - 3 Then
                           
            If Range("A" & Regel) <> "" Or Range("A" & Regel) <> "" Then
               
                're-init
                Regel = Regel - Kader_regel
                Blad_regel = 0
                Kader_regel = 0
                Regel_nr = 0
                empty_regel = 0
                ActiveSheet.HPageBreaks.Add Before:=Range("A" & Regel + 1)
            
            Else
            
         
            
            End If
            
                       
            Blad_regel = 0
        End If
        
               
        Range("AA" & Regel) = Regel
        Regel = Regel + 1
        Range("AD" & Regel) = Regel_nr
        Regel_nr = Regel_nr + 1
        Blad_regel = Blad_regel + 1
       
    Wend


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[Superzeeuw]

Robin,

Ziet er goed uit je code.

Overigens leuk dat je de oplossing met ons hebt willen delen.

 

[robinvdveeken]

Bedankt Superzeeuw,

Het is leuk om te zien hoe je jezelf kan verbeteren.
Sinds september ben ik aan de slag gegaan met Visual Basic, en het vordert gestaag.
Daarbij heb ik best vaak het forum gebruikt. ik zie het als mijn plicht oplossingen te delen voor andere (toekomstige) forumleden.

Groeten,
Robin

 

[robinvdveeken]

Daarbij moet ik nog wel even zeggen dat ik het een gecompliceerde manier vind om de pagina-einden in te stellen. Een simpele functie in Visual Basic hiervoor zou een welkome aanvulling zijn, evenals het maken van een inhoudsopgave.

Groeten,
Robin

 

[Superzeeuw]

Robin,

Een applicatie kan tot op een bepaalde hoogte zaken bepalen maar niet waar het een pagina moet afbreken.
Ook al staat er een tabel dan nog weet excel niet welk gedeelte de tabel is.
Probeer dit maar eens in Word en dan zul je zien dat ook daar een tabel doormidden wordt geknipt.

Een index maken kan in Word maar makkelijk is het niet maar Excel ondersteunt dit niet omdat het een spreadsheet is. Op basis waarvan zou excel een index moeten bepalen.

Je hebt wel mogelijkheden om dit eenvoudiger te sturen door bijvoorbeeld te werken met een ander lettertype, groter lettertype, cel kleur, o.i.d.
Dan kun je daarna een macro runnen die de afwijkingen opspoor en op basis daarvan een index samenstelt.

 

[robinvdveeken]

Beste Superzeeuw,

Ik begrijp je reactie. Toch lijken het mij vrij algemene zaken welke voor een brede gebruikersgroep een welkome aanvulling zouden zijn.

Ter info, met de inhoudsopgave is inderdaad gelukt. Inderdaad door te selecteren op lettertype, grote en bold.

Groeten,
Robin van der Veeken

 

[cow18]

dit is een oude versie van een pagebreaker die ik nog ergens liggen had. Ik zou zelf nog moeten kijken of en hoe hij het doet.
PS. hij kijkt naar lege cellen in kolom D om te beslissen.

Sub HorizontalePaginaEindes()
  Dim lRij As Long, lRijEinde As Long, lRijBreak As Long, Kolom As String

  Kolom = "D"                                              'indien opeenvolgende cellen in deze kolom dezelfde inhoud hebben, dan veronderstelt dat dat ze niet gescheiden mogen worden
  lRijEinde = Cells(Rows.Count, Kolom).End(xlUp).Row

  'verwijder alle vroeger handmatige horizontale paginaeindes
  For lRij = 2 To lRijEinde
    ActiveSheet.Rows(lRij).PageBreak = xlPageBreakNone
  Next

  'loop nu alle rijen af en als het pagina-einde midden in een blok staat,
  'dan moet deze verhuizen naar het begin van de blok
  For lRij = 1 To lRijEinde
    If Cells(lRij, Kolom) = "" Then lRijBreak = lRij
    If ActiveSheet.Rows(lRij).PageBreak <> xlPageBreakNone Then
      ActiveSheet.Rows(lRij).PageBreak = xlPageBreakNone
      ActiveSheet.Rows(lRijBreak).PageBreak = xlPageBreakManual
    End If
  Next
End Sub