suntzu_2002
New Member
- Joined
- Jan 15, 2009
- Messages
- 22
I'm using the following code to allow users to select multiple sheets within a workbook. It will then print out 6 copies of each sheet with a different header. The code will probably look familiar to a lot of you since I think I grabbed it from this forum with some minor changes made by me.
The problem is that these are not collated and it can take a lot of time to collate them by hand. I need all the customer copies together, all the shop copies together, etc...
I was trying to get the code to take each checkbox, add the sheet name to an array, and print the array of all sheets 6 times with the different header, and different print area for the Shop copy.
Can anyone help me get started?
Thank you!
The problem is that these are not collated and it can take a lot of time to collate them by hand. I need all the customer copies together, all the shop copies together, etc...
I was trying to get the code to take each checkbox, add the sheet name to an array, and print the array of all sheets 6 times with the different header, and different print area for the Shop copy.
Can anyone help me get started?
Thank you!
Code:
Sub PrintCopies()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
Dim lRow As Long
Application.ScreenUpdating = False
' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0
' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i
' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240
' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"
End With
' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront
' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
With ActiveSheet
' Prints out copies with custom headers and adjusts print area
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Customer Copy*"
lRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("A1", "K" & lRow).Address
.PrintOut
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Carrier Copy*"
.PrintOut
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Office Copy*"
.PrintOut
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Transportation Copy*"
.PrintOut
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*Scheduler's Copy*"
.PrintOut
.PageSetup.CenterHeader = "&""Arial,bold""&20" & "*SHOP COPY*"
lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("A1", "M" & lRow).Address
.PrintOut
.PageSetup.CenterHeader = ""
' ActiveSheet.PrintPreview 'for debugging
End With
End If
Next cb
End If
Else
MsgBox "All worksheets are empty."
End If
' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
' Reactivate original sheet
CurrentSheet.Activate
End Sub