do not print blank pages

max_max

max_max

Board Regular
Joined
Jun 29, 2013
Messages
58
Hi to all
is it possible to add to the macro not to print pages 5/6 or 3/4 if they are blank?
Now the page order is in horizontal priority.


VBA Code: 
'Public NoPrint As Boolean

Option Explicit




Sub stampa_tagli()


   Dim avviso As String
  
      
     ActiveSheet.Unprotect ' "987654"
  Application.ScreenUpdating = False
 
 
 avviso = MsgBox("Stampo tabella?" & Chr(13) & Chr(13) & _
 "Prima di stampare controlla " & Chr(13) & _
 "le interruzioni di pagina!", vbQuestion + vbYesNo + vbDefaultButton2, "STAMPA")
 
 
  If avviso = vbNo Then
 
   ActiveSheet.Protect ' "987654"
  
  Exit Sub
 
 
  End If
 
 
 
'------------------------------------------------------------------------------------


    ActiveWindow.View = xlPageBreakPreview
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
 
    Set ActiveSheet.VPageBreaks(1).Location = Range("AO2")
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
           'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
  
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    
    ActiveWindow.View = xlNormalView
      
      
      
'------------------------------------------------------------------------------------

 
                   'If WorksheetFunction.CountA(Range("AD3:BA121")) = 0 Then '<<<<< not work
                  
 
  If Application.CountIfs(Range("AD3:BA121"), "<>0") = 0 Then
 
 
 
 
  Columns("AD:BA").Select
  Selection.EntireColumn.Hidden = True
          
          
          
   ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    With ActiveSheet.PageSetup
        .Zoom = 78
    End With
    
    
  ActiveWindow.View = xlPageBreakPreview
  ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
          
        
          
           'NoPrint = True
        ActiveWindow.SelectedSheets.PrintPreview
           'NoPrint = False
  
  
    Columns("AC:BB").Select
    Selection.EntireColumn.Hidden = False
    
            
  
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BG$121"
    
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
         'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    
  
        
  
         'ActiveWindow.View = xlPageBreakPreview
   ActiveWindow.View = xlNormalView
  
  
   Range("D3").Select
  
  
   Else
  
  
  
   If WorksheetFunction.CountA(Range("AD3:BA121")) >= 0 Then
  
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    With ActiveSheet.PageSetup
        .Zoom = 78
    End With
    
        
        
        
        'NoPrint = True
    ActiveWindow.SelectedSheets.PrintPreview
        'NoPrint = False
  
        
        
  
    ActiveWindow.View = xlPageBreakPreview
    
    
  
    
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BG$121"
    
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
          'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
  
  
    
    ActiveWindow.View = xlNormalView
    
    
    Range("D3").Select
    
    
   End If
   End If
  
  
  
 '------------------------------------------------------------------------------------
 
 
 
  
  'ActiveSheet.Protect '"987654"
  Application.ScreenUpdating = True
 
 
 
 
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
I have added these functions
VBA Code: 
If Application.CountIfs(Range("C2:AC41"), "<>0") > 0 Then '<<< not
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$bb$41"
    
    End If
    
          
        
    If Application.CountIfs(Range("C42:BA121"), "<>0") = 0 Then
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$41"
    
    End If
    
        
    If Application.CountIfs(Range("C82:BA121"), "<>0") = 0 Then
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$81"
    
    End If


but this I am unable to correct

Code: 
If Application.CountIfs(Range("C2:AC41"), "<>0") > 0 Then '<<< not
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$bb$41"
    
    End If

the added functions are for adjusting the page break if there are blank sheets
the wrong function is for a sheet to be printed

the macro

Code: 
'Public NoPrint As Boolean


Option Explicit




Sub stampa_tagli()


   Dim avviso As String
  
      
     ActiveSheet.Unprotect ' "987654"
  Application.ScreenUpdating = False
 
 
 avviso = MsgBox("Stampo tabella tagli?" & Chr(13) & Chr(13) & _
 "Prima di stampare controlla " & Chr(13) & _
 "le interruzioni di pagina!", vbQuestion + vbYesNo + vbDefaultButton2, "STAMPA")
 
 
  If avviso = vbNo Then
 
   'ActiveSheet.Protect ' "987654"
  
  Exit Sub
 
 
  End If
 
 
 
'------------------------------------------------------------------------------------


    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.VPageBreaks(1).Location = Range("AO2")
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
    'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    ActiveWindow.View = xlNormalView
      
      
      
'------------------------------------------------------------------------------------

 
  'If WorksheetFunction.CountA(Range("AD3:BA121")) = 0 Then 'not work
 
    If Application.CountIfs(Range("AD3:BA121"), "<>0") = 0 Then '<<< new alex blakenburg
 
 
  Columns("AD:BA").Select
  Selection.EntireColumn.Hidden = True
           'End If
          
          
   ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    With ActiveSheet.PageSetup
        .Zoom = 78
    End With
    
    
    
  ActiveWindow.View = xlPageBreakPreview
  ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
          
          
          
          
    
    If Application.CountIfs(Range("C2:AC41"), "<>0") > 0 Then '<<< not
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$bb$41"
    
    End If
    
          
        
    If Application.CountIfs(Range("C42:BA121"), "<>0") = 0 Then
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$41"
    
    End If
    
        
    If Application.CountIfs(Range("C82:BA121"), "<>0") = 0 Then
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$81"
    
    End If
        
        
      
        
        
        
        
        
          
           'NoPrint = True
        ActiveWindow.SelectedSheets.PrintPreview
           'NoPrint = False
          
          
          
  
    Columns("AC:BB").Select
    Selection.EntireColumn.Hidden = False
    
          
  
  
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BG$121"
    
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
         'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    
  
        
  
         'ActiveWindow.View = xlPageBreakPreview
   ActiveWindow.View = xlNormalView
  
  
   Range("D3").Select
  
  
  
   Else
  
  
  
   'If WorksheetFunction.CountA(Range("AD3:BA121")) >= 0 Then
  
   If Application.CountIfs(Range("AD3:BA121"), "<>0") >= 0 Then '<<< new alex blakenburg
  
  
                
 
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    With ActiveSheet.PageSetup
        .Zoom = 78
    End With
    
    
  
    
    
    
    
    
    If Application.CountIfs(Range("C2:BA41"), "<>0") >= 0 And Application.CountIfs(Range("C42:BA121"), "<>0") = 0 Then
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$41"
    
    End If
    
        
    
          
        
    If Application.CountIfs(Range("C42:BA121"), "<>0") = 0 Then
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$41"
    
    End If
    
        
        
    If Application.CountIfs(Range("C82:BA121"), "<>0") = 0 Then
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$81"
    
    End If
    
    
        
        
    
    
  
          
        
    
        
    
    
    With ActiveSheet.PageSetup
        .Zoom = 78
    End With
    
    
    
    
    
    
    
    
        
        
        'NoPrint = True
    ActiveWindow.SelectedSheets.PrintPreview
        'NoPrint = False
  
        
        
  
    ActiveWindow.View = xlPageBreakPreview
    
    
    
    
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BG$121"
    
    Set ActiveSheet.VPageBreaks(1).Location = Range("AD2")
    'ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    Set ActiveSheet.HPageBreaks(1).Location = Range("C42")
    Set ActiveSheet.HPageBreaks(2).Location = Range("C82")
    
    ActiveSheet.PageSetup.PrintArea = "$C$2:$BB$121"
    
    ActiveWindow.View = xlNormalView
    
    
    
    
    
     Range("D3").Select
    
    
    
   End If
   End If
  
  
  
 '------------------------------------------------------------------------------------
 
 
 
  
  'ActiveSheet.Protect '"987654"
  Application.ScreenUpdating = True
 
 
 
 
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Transfer from 1 page to another
Replies
1
Views
107
bobaol
B
F
  • Solved
Page Breaks and Subscript out of Range
Replies
1
Views
440
Farscape2020
F
A
  • Question
Filtered Rows prints 7 pages when print area is set to 2
Replies
0
Views
130
angusn
A
H
  • Question
Macro to show Page Preview
Replies
0
Views
206
howard
H
H
  • Question
Macro to Set Page Breaks in Range Named "Journals"
Replies
1
Views
327
howard
H

Forum statistics

Threads
1,214,942
Messages
6,122,367
Members
449,080
Latest member
Armadillos

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top