Nadat met macro lege rijen zijn verborgen extra rijen onderaan toevoegen

[wlsandman]

Goedendag,

Ik heb de volgende code 'ooit' wel eens hier van het forum geplukt en aangepast .

Private Sub Image4_Click()

If MsgBox("Wilt u dit bestand printen?", vbYesNo + vbInformation) = vbYes Then
Sheets("Overrijlijst Bleiswijk").Select

ActiveSheet.Unprotect

Application.ScreenUpdating = False
Dim r As Range
For Each r In Range("A9:A80") ' Dit is de range waar de nullen kunnen staan
If r.Value = "" Then
r.EntireRow.Hidden = True ' Verstoppen van de rij
Else
r.EntireRow.Hidden = False ' Zichtbaar maken van de rij
End If
Next
Rows("1:91").Select ' Het gedeelte dat geprint moet worden selecteren
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.EntireRow.Hidden = False ' Alle rijen weer zichtbaar maken
Application.ScreenUpdating = True
Range("A1").Select ' De cell onder de knop selecteren (gewoon voor het oog)

ActiveSheet.Protect
Sheets("Invoer").Select

Else
MsgBox "Het bestand is niet geprint!", vbCritical
End If
End Sub

Uit een lijst op een werkblad verbergt het tijdelijk de lege rijen en na het printen zet deze ze weer op zichtbaar. Dit werkt allemaal perfect, alleen kwam ik nu een opmerking tegen dat iemand onderaan de lijst nog extra lege regels wilt hebben.

Dus als iemand de lijst uitprint, dan wil deze soms nog met de hand extra gegevens op de lijst invullen.

De code zou dus aangepast moeten worden, dat als nadat:

For Each r In Range("A9:A80") ' Dit is de range waar de nullen kunnen staan
If r.Value = "" Then
r.EntireRow.Hidden = True ' Verstoppen van de rij
Else
r.EntireRow.Hidden = False ' Zichtbaar maken van de rij
End If
Next

Er onderaan de lijst (die op dat moment ingekort is) nog eens extra x lege rijen toevoegd en daarna uitprint.

Na het printen moeten deze extra lege rijen dan weer verwijderd worden!

Ik hoop dat jullie mij kunnen helpen :thumb:

 

[Wigi]

Dat is in principe niet echt moeilijk, kan je zelfs de code met de macro recorder opnemen, maar kan je niet gewoon

Rows("1:91").Select

met een paar regels uitbreiden?

Wigi

 

[wlsandman]

Dat wordt lastig, aangezien ik eigenlijk 2 verschillende ranges heb in een blad, waar rijen verborgen kunnen worden of blijven staan. Zie bijlage

Dit is een los werkblad, dat ik al eerder met behulp van jouw code wigi :thumb: , los opgeslagen als waardes heb.

In het hoofddocument staan in dat blad formules. Als ik het blad uitprint dan worden de lege rijen (waar dus geen gegevens in staan) tijdelijk verborgen. In allebei de ranges worden die rijen verborgen.

ik heb wel iets geprobeerd met een macro, om twee verschillende codes te combineren, maar het lukt mij echt niet.

Sub legerijentoevoegen()
Range("A9:A69" & Rows.Count).End(xlUp).Offset (1) ''1e range
Range("A70:A81" & Rows.Count).End(xlUp).Offset (1) '2e range
Selection.EntireRow.Insert
End Sub

Pff, het lukt mij dus echt niet...

 

[wlsandman]

Na lang *****n heb ik een oplossing gevonden:

Private Sub Image4_Click()

If MsgBox("Wilt u dit bestand printen?", vbYesNo + vbInformation) = vbYes Then
Sheets("Overrijlijst Bleiswijk").Select

ActiveSheet.Unprotect

Application.ScreenUpdating = False
Dim r As Range
For Each r In Range("A9:A80") ' Dit is de range waar de nullen kunnen staan
If r.Value = "" Then
r.EntireRow.Hidden = True ' Verstoppen van de rij
Else
r.EntireRow.Hidden = False ' Zichtbaar maken van de rij
End If
Next
    Range("A67").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert  '6 rijen toevoegen aan range1
    Range("A86").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert '4 rijen toevoegen aan range2
Rows("1:101").Select ' Het gedeelte dat geprint moet worden selecteren
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.EntireRow.Hidden = False ' Alle rijen weer zichtbaar maken
Application.ScreenUpdating = True
Range("A1").Select ' De cell onder de knop selecteren (gewoon voor het oog)
    Rows("68:73").Select
    Range("A73").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=18
    Rows("80:83").Select
    Range("A83").Activate
    Selection.Delete Shift:=xlUp
ActiveSheet.Protect
Sheets("Invoer").Select

Else
MsgBox "Het bestand is niet geprint!", vbCritical
End If
End Sub

 

[Wigi]

Ipv dit

...
    Range("A67").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert  '6 rijen toevoegen aan range1
    Range("A86").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert '4 rijen toevoegen aan range2
...

doe je veel beter dit:

Rows("67:72").Insert xlDown
Rows("86:89").Insert xlDown

en van dit:

Rows("68:73").Select
    Range("A73").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=18

maak je:

Rows("68:73").Delete xlUp

Wigi

 

[wlsandman]

Ipv dit

...
    Range("A67").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert  '6 rijen toevoegen aan range1
    Range("A86").Select
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert
    Selection.EntireRow.Insert '4 rijen toevoegen aan range2
...

doe je veel beter dit:

Rows("67:72").Insert xlDown
Rows("86:89").Insert xlDown

en van dit:

Rows("68:73").Select
    Range("A73").Activate
    Selection.Delete Shift:=xlUp
    ActiveWindow.SmallScroll Down:=18

maak je:

Rows("68:73").Delete xlUp

Wigi

Zulke dingen weet ik dan weer niet

Scheelt weer wat secondes aan tijd!