[RESOLVED] Excel VBA - Print only "not empty" pages

[Zeljko]

Excel 2007, VBA
I need to print only pages with some text on it.
Blank pages are random and they exsist because i put page break each one row or each two rows in that sheet (i need to print one or two rows on each sheet). In sheet these blanke pages are hidden rows but because page break they printout blank.

Can i make loop and test condition something like this?:
For each page in pages (printpreview)
If page (printpreview) > 0 letters then
printout
End If
Next page

[westconn1]

i don't think you can do it as easy as that, but you can test like this, this only test the first page, so you would have to loop through all the pagebreaks to test each range, then print each range

Set s = ThisWorkbook.Sheets("sheet2")
With s
vb = .VPageBreaks(1).Location.Column - 1
hb = .HPageBreaks(1).Location.Row - 1
Set r = .Range(.Cells(1, 1), .Cells(hb, vb))
For Each c In r
    If Not IsEmpty(c) Then notempty = True: Exit For
Next
If notempty Then r.PrintOut

[westconn1]

this should work with any number of pages, i tested it with 4 pages, 2x2

Set s = ThisWorkbook.Sheets("sheet2")
With s
.Activate
s.Application.ActiveWindow.View = xlPageBreakPreview
 
 
vs = 1
hs = 1
vp = .VPageBreaks.Count
hp = .HPageBreaks.Count
For i = 1 To vp + 1
    For j = 1 To hp + 1
        If i = vp + 1 Then
            vb = .UsedRange.Columns.Count
            Else
            vb = .VPageBreaks(i).Location.Column - 1
        End If
        If j = hp + 1 Then
            hb = .UsedRange.Rows.Count + .UsedRange.Row - 1
            Else
            hb = .HPageBreaks(j).Location.Row - 1
        End If
        Set r = .Range(.Cells(hs, vs), .Cells(hb, vb))
        Debug.Print r.Address
        For Each c In r
            If Not IsEmpty(c) Then notempty = True: Exit For
        Next
        If notempty Then r.PrintOut
        hs = hb + 1
    Next j
    hs = 1
    vs = vb + 1
Next i
End With

[Zeljko]

Thanks for help Westconn1 but that didn't work
I still get empty pages out.

Here is attach with this workbook and can you please look at it and see whats wrong?
In this workbook I cut out 4/5 of TOC (in bouth sheets) for easyer working (somethimes is on sheet "Naslovi" one row per page somethimes are two rows per page, in original file)
Sheet pass = " " 'space
In normal work, one can edit only blue fields in sheet "Sadrzaj", edit "1" and "0" on left side, btn "Skrati", than print first sheet, than second sheet (rows "marked" with "0" in first sheet are not suposed to printout!).

btn "Skrati" - hide rows in both sheets that have "0" on column A.
btn "Produzi" - unhide rows in both sheets.
btn "Printaj" - your VBA code

Thanks in advance

[westconn1]

when i wrote the loop i forgot to rest the boolean, should be

If notempty Then r.PrintOut
notempty = false 'so that next page range is empty till it checks data

i can not open your workbook

[Zeljko]

- Hm, i put that noempty inside and still no luck

- About the attach, here is Excel 2003 version - if that's the problem with opening it.

[westconn1]

lol, that is why i could not open it
as you have a print area set, you need to use that to get all your print ranges, also your hidden cells are not empty as they have formulas in them

try like this

Sub Printaj_Naslove()
Application.ScreenUpdating = False
Call UnLockS
Dim s As Worksheet
Dim r As Range, p As Range, vs As Integer, vb As Integer, vp As Integer
hs As Integer, hb As Integer, hp As Integer
 
      Set s = ThisWorkbook.Sheets("Naslovi")
      With s
      .Activate
      s.Application.ActiveWindow.View = xlPageBreakPreview
      Set p = .Range(.PageSetup.PrintArea) ' set the print area as a range, so we can find the edges
      vs = p.Range("a1").Row
      hs = p.Range("A1").Column
      vp = .VPageBreaks.Count
      hp = .HPageBreaks.Count
      For i = 1 To vp + 1
          For j = 1 To hp + 1
              If i = vp + 1 Then
                  vb = p.Range("a1").Column + p.Columns.Count - 1
                  Else
                  vb = .VPageBreaks(i).Location.Column - 1
              End If
              If j = hp + 1 Then
                  hb = p.Range("a1").Row + p.Rows.Count - 1
                  Else
                  hb = .HPageBreaks(j).Location.Row - 1
              End If
              Set r = .Range(.Cells(hs, vs), .Cells(hb, vb))
              Debug.Print r.Address;
'              For Each c In r
'                  If Not IsEmpty(c) Then notempty = True: Exit For
'              Next
'              If notempty Then Debug.Print , r.Address; ' r.PrintOut
                If r.EntireRow.Hidden = False Then Debug.Print , r.Address;: r.PrintOut
                 
              notempty = False
              Debug.Print
              hs = hb + 1
          Next j
          hs = 1
          vs = vb + 1
      Next i
      End With
 
 
 
Sheets("Sadrzaj").Select
    Range("B1").Select
Call LockS
Application.ScreenUpdating = True
End Sub

you can take out the debug prints, i was just using that to test the ranges being returned, which are as below, showing the ranges returned and the ranges printed

$B$3:$P$3     $B$3:$P$3
$B$4:$P$4     $B$4:$P$4
$B$5:$P$5     $B$5:$P$5
$B$6:$P$6     $B$6:$P$6
$B$7:$P$7     $B$7:$P$7
$B$8:$P$8     $B$8:$P$8
$B$9:$P$9
$B$10:$P$10
$B$11:$P$11
$B$12:$P$12
$B$13:$P$13
$B$14:$P$14   $B$14:$P$14
$B$15:$P$15   $B$15:$P$15
$B$16:$P$16
$B$17:$P$17
$B$18:$P$18   $B$18:$P$18
$B$19:$P$19   $B$19:$P$19
$B$20:$P$20   $B$20:$P$20
$B$21:$P$21   $B$21:$P$21
$B$22:$P$23   $B$22:$P$23
$B$24:$P$25   $B$24:$P$25
$B$26:$P$27
$B$28:$P$29
$B$30:$P$31
$B$32:$P$33
$B$34:$P$35
$B$36:$P$37
$B$38:$P$39
$B$40:$P$41   $B$40:$P$41
$B$42:$P$43   $B$42:$P$43
$B$44:$P$45   $B$44:$P$45
$B$46:$P$47   $B$46:$P$47
$B$48:$P$49   $B$48:$P$49
$B$50:$P$51   $B$50:$P$51
$B$52:$P$53   $B$52:$P$53

[Zeljko]

Thanks for helping me so much, it worked partialy
Today, I lerned that i can make "debug print" to immidiate window and see result before printing (saves some paper).

But the problem is that in Debug print i get all corect pages, but on printer i get only even pages out (you can test that if you printout those pages on paper or on some kind of pdf printer - adobe pdf printer, pdf995 etc.)
I tried to make corections in your code but that did'nt produce results.

[westconn1]

well at least that is a start, i have no idea why it would do like that, check your page/ printer setup etc, i will look at it later

i did a test run, my pdf printer did 21 pages, which was the same as the number of range printed to the debug window

[anhn]

This is a better procedure, it use SUBTOTAL function 103 (COUNTA) to count non-blank cells in each page, instead of checking hidden rows and empty cells. You don't need to Unlock then Lock the sheet.
I recommend you to add Option Explicit to the top of the module and declare all variables used.

Sub Printaj_Naslove()
   Dim ws As Worksheet
   Dim prRange As Range
   Dim vp As Long, hp As Long
   Dim i  As Long, j  As Long
   Dim c1 As Long, c2 As Long
   Dim r1 As Long, r2 As Long
   Dim n  As Long
   Dim BreakRows() As Long
   Dim BreakCols() As Long
   Dim PageRange As Range
   
   Set ws = ThisWorkbook.Sheets("Naslovi")
   With ws
      vp = .VPageBreaks.Count
      hp = .HPageBreaks.Count
      
      ReDim BreakCols(0 To vp + 1)
      ReDim BreakRows(0 To hp + 1)
      
      Set prRange = .Range(.PageSetup.PrintArea)
      
      BreakCols(0) = prRange.Column
      For i = 1 To vp
         BreakCols(i) = .VPageBreaks(i).Location.Column
      Next
      BreakCols(vp + 1) = BreakCols(0) + prRange.Columns.Count
      
      BreakRows(0) = prRange.Row
      For j = 1 To hp
         BreakRows(j) = .HPageBreaks(j).Location.Row
      Next
      BreakRows(hp + 1) = BreakRows(0) + prRange.Rows.Count
      
      For i = 0 To vp
         c1 = BreakCols(i)
         c2 = BreakCols(i + 1) - 1
         For j = 0 To hp
            r1 = BreakRows(j)
            r2 = BreakRows(j + 1) - 1
            Set PageRange = .Range(.Cells(r1, c1), .Cells(r2, c2))
            n = WorksheetFunction.Subtotal(103, PageRange) '-- Count non-blank cells
            If n > 0 Then
               Debug.Print PageRange.Address
               'PageRange.PrintOut
            End If
         Next
      Next
   End With
End Sub

[Zeljko]

Thanks guys for your effort, help and detaild explanations.
Method from Anhn worked perfectly.