PDA

View Full Version : Convert workbook code to worksheet code



Nemesis696
06-27-2011, 07:27 AM
Hi guys!

I use this code in my workbook (found it on internet :whistle:), to hide specific cells of worksheet - "Sheet1" from printing.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Me.ActiveSheet.Name = "Sheet1" _
Then Cancel = True Else Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False '

Dim iArchive As New Collection
Dim iSource As Range, iCell As Range
Set iSource = Me.ActiveSheet.Range("B1:AJ1, B2:AJ2, U3:AJ3, U4:AJ4, AD6:AJ6, AD7:AJ7, B8:AB8, B14:AJ14, B20:AJ20, B22:AJ22, B24:AJ24, B26:AJ26, B45:AJ45, B47:AJ47, B55:AJ55, B57:AJ57, B59:AJ59")
For Each iCell In iSource
With iCell
iArchive.Add .Font.Color, .Address
.Font.Color = .Interior.Color
End With
Next
Me.ActiveSheet.PrintOut 'Copies:=1
For Each iCell In iSource
iCell.Font.Color = iArchive(iCell.Address)
Next

Application.EnableEvents = True '
Application.ScreenUpdating = True
End Sub
Now i need to add 2-3 additional worksheets to my workbook with their own, hidden from printing cell's. How do I convert this code from workbook, to each separate worksheet? Or, how to add additional worksheet's, in to this code?

shrivallabha
06-28-2011, 09:16 AM
You can use Select case statement based on Activesheet.Name as below:
Replace this statement:
Set iSource = Me.ActiveSheet.Range("B1:AJ1, B2:AJ2, U3:AJ3, U4:AJ4, AD6:AJ6, AD7:AJ7, B8:AB8, B14:AJ14, B20:AJ20, B22:AJ22, B24:AJ24, B26:AJ26, B45:AJ45, B47:AJ47, B55:AJ55, B57:AJ57, B59:AJ59")
With individual cases like:
Select Case ActiveSheet.Name
Case "Sheet1"
Set iSource = Sheet1.Range("B1:AJ1")
Case "Sheet2"
Set iSource = Sheet2.Range("B2:AJ2")
Case "Sheet3"
Set iSource = Sheet2.Range("B2:AJ2")
End Select

Nemesis696
06-28-2011, 10:24 AM
Hi Shrivallabha!

Thanks for reply!

Do you mean like this? :

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Me.ActiveSheet.Name = "Sheet1" _
Then Cancel = True Else Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False '

Dim iArchive As New Collection
Dim iSource As Range, iCell As Range
Select Case ActiveSheet.Name
Case "Sheet1"
Set iSource = Sheet1.Range("B1:AJ1, B2:AJ2, U3:AJ3, U4:AJ4, AD6:AJ6, AD7:AJ7, B8:AB8, B14:AJ14, B20:AJ20, B22:AJ22, B24:AJ24, B26:AJ26, B45:AJ45, B47:AJ47, B55:AJ55, B57:AJ57, B59:AJ59")
Case "Sheet2"
Set iSource = Sheet2.Range("A2:D2")
End Select
For Each iCell In iSource
With iCell
iArchive.Add .Font.Color, .Address
.Font.Color = .Interior.Color
End With
Next
Me.ActiveSheet.PrintOut 'Copies:=1
For Each iCell In iSource
iCell.Font.Color = iArchive(iCell.Address)
Next

Application.EnableEvents = True '
Application.ScreenUpdating = True
End Sub


With this one, my workbook ignores the VBA code completely and prints out all the stuff that must be hidden when printing. Please check, if I did something wrong. I can attach my workbook to this thread if it's necessary.

shrivallabha
06-29-2011, 07:04 AM
This part:
If Me.ActiveSheet.Name = "Sheet1" _
Then Cancel = True Else Exit Sub

If your activesheet is any sheet other than Sheet1 then this sub-routine will not be executed thanks to this statement.

So first, try to execute code by selecting "Sheet1". If it still gives problem then we can always check it.