Macro om statement of content te maken en tevens boek te printen

[klupwuk]

Hoi allen,

ik ben bezig met het schrijven van een macro om een workbook te printen, maar voordat de macro print moet hij eerst kijken of er uberhaubt op de pagina iets staat om pagina's waar niks op staat niet uit te printen.
Dat is me gelukt, maar nu wilde ik eigenlijk nog een extra stukje invoegen, namelijk om een statement of content op te nemen in de print macro waarbij de macro regels verbergt waar geen data op staat.
Daarvoor heb ik dezelfde cel genomen als waar de print macro al eerder naar toe verwees, daar staat een =IF(ABS(SUM)) formule die terugkomt met een 1 of een 0.
Nu moet elke regel waar een 0 op terugkomt worden gehide en de regels waar een 1 op staat niet.

De code die ik tot nu toe heb geschreven is als volgt:

Sub print_workbook()
    WorkSheets("Content").Select
  
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    x = Range("ContentRow").Value
    y = Range("ContentCol").Value
    
    Dim currentSheet As String

    Cells(x, y).Select

    Do While Cells(x, y).Value <> ""
    
    If Cells(x, y).Value < 1 Then
        Row.Hide
    End If
    Worksheets("Content").Select
    x = x + 1
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    Dim Sh As Worksheet
    Dim Arr() As String
    Dim N As Integer
    N = 0
    For Each Sh In ActiveWorkbook.Worksheets
        If Worksheet.Visible = xlSheetVisible And Sh.Range("B1").Value = 1 Then
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = Sh.Name
        End If
    Next
    With ActiveWorkbook
        .Worksheets(Arr).PrintOut
    End With
End Sub

Kan het zijn dat deze code fout loopt omdat de code in eerste instantie is geschreven in VBA 6.5, maar ik op deze pc momenteel VBA 6.3 ben genoodzaakt te hanteren?

Mocht er iemand een oplossing weten dan hoor ik dat graag in ieder geval

 

[klupwuk]

Na een hoop geklooi, wat gegoogle en veel proberen ben ik er uiteindelijk uit gekomen.

In plaats van het zoeken naar 1-tjes en 0-lletjes heb ik er nu een if formule van gemaakt.
Die komt terug met een true of false.
De macro gaat nu alles waar een false staat inklappen, vervolgens gaat ie de tabbladen printen waar daadwerkelijk data op staat om vervolgens de inhoudsopgave weer uit te klappen voor de volgende keer.

uiteindelijke code zit nu zo in elkaar:

Sub print_workbook()

ActiveSheet.Unprotect Password:="*******"
    
    Dim currentSheet As String
    Dim Sh As Worksheet
    Dim Arr() As String
    Dim N As Integer
    N = 0
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    x = Range("ContentRow").Value
    Y = Range("ContentCol").Value
    
    Sheets("Content").Select
        Cells(x, Y).Select
            Do While Cells(x, Y).Value <> ""
                If Cells(x, Y).Value = False Then
                Cells(x, Y).EntireRow.Hidden = True
                Else: Cells(x, Y).EntireRow.Hidden = False
                End If
            Worksheets("Content").Select
            x = x + 1
            Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Visible = xlSheetVisible And Sh.Range("B1").Value = 1 Then
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = Sh.Name
        End If
    Next
    With ActiveWorkbook
        .Worksheets(Arr).PrintOut
    End With
    
    Rows("13:51").Select
    Selection.EntireRow.Hidden = False
    
ActiveSheet.Protect Password:="*******"
    
End Sub

Mocht er iemand nog een geweldig idee hebben om deze code in te korten dan hoor ik het graag, dan kan ik dat nog doorvoeren.

 

[Wigi]

Regel 1: declareer je variabelen goed bvb. x en Y.

Vervolgens zou de lus er best uitgehaald kunnen worden (als het over redelijk wat rijen gaat zal dat de macro duidelijk sneller doen gaan). Over hoeveel rijen gaat het ongeveer?

Het printen zit goed :thumb:

Die "13:51" vind ik wel nog iets te veel hardgecodeerd.

Wigi

 

[Wigi]

Ga je toch voor een lus, doe het dan bvb. zo:

Dim r As Range
Dim rBegincel As Range
Dim ws As Worksheet

Set ws = Sheets("Content")
Set rBegincel = ws.Cells(Range("ContentRow").Value, Range("ContentCol").Value)

For Each r In ws.Range(rBegincel.Address, rBegincel.End(xlDown).Address)

    ws.Rows(r).Hidden = Not r.Value

Next

Wigi