Select Worksheets to Print

  • Thread starter Thread starter ken.mcdaniel
  • Start date Start date
K

ken.mcdaniel

Does anyone have a code example of how to bring up a
dialog box that allows the user to select which worksheets
to print and then printing only those selections?
Thanks!
 
Hi Ken
Something like this should work

*********************************************

Dim xls As Worksheet
Dim Z As Integer, X As Integer
Dim varReturn As Variant

Z = ActiveWorkbook.ActiveSheet.Index

Application.ScreenUpdating = False
Application.Cursor = xlWait
For Each xls In ActiveWindow.SelectedSheets
xls.Activate
ActiveSheet..PrintOut Copies:=1, Collate:=True
Next xls
ActiveWorkbook.Sheets(Z).Activate
Application.Cursor = xlDefault
Application.ScreenUpdating = True

*********************************************
----- ken.mcdaniel wrote: -----

Does anyone have a code example of how to bring up a
dialog box that allows the user to select which worksheets
to print and then printing only those selections?
Thanks!
 
Hi Ken

You can use a userform with a listbox and a button on it
Add this code in the Userform module
In the properties of the listbox set Multiselect to 1

Private Sub CommandButton1_Click()
Dim arr() As String
Dim N As Integer
N = 0
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
N = N + 1
ReDim Preserve arr(1 To N)
arr(N) = ListBox1.List(i)
End If
Next i
If N = 0 Then
MsgBox "You must select at least one Sheet"
Exit Sub
End If
ThisWorkbook.Worksheets(arr).PrintOut
End Sub

Private Sub UserForm_Initialize()
For Each ws In ActiveWorkbook.Sheets
If ws.Visible = True Then
Me.ListBox1.AddItem (ws.Name)
End If
Next
End Sub
 
One way is with an "old fashioned" list with an x beside it

Sub PRINTIT()'properly collated
Application.ScreenUpdating = False
On Error Resume Next
For x = [PrintOptionsRange].Rows.Count + 4 To 6 Step -1
c = Cells(x, 1)
If UCase(Cells(x, 2)) = "X" Then
If Range("Preview") Then
Sheets(c).PrintPreview
Else
Sheets(c).PrintOut
End If
End If
Next x
Application.ScreenUpdating = True
End Sub
 
Back
Top