Select Sheets to Print

C

CurlyDave

I like this code that creates a list(using Checkboxes) in a UserForm
of all the worksheets in the workbook to print
Found Here
http://j-walk.com/ss/excel/tips/tip48.htm

This is the Code

'--------------------------
Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox
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
ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
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
'--------------------------------

The setback is that the UserForm becomes longer than the Screen and
unable to see all the sheets.(Because of the large number of sheets in
the workbook)

Is there a way to split the sheet list into two columns on the
UserForm?
 
R

Rick Rothstein

Wouldn't simply clicking Ctrl+<Left Mouse Button> on each Tab you wanted to
print (in order to group them) and then clicking File/Print (the Active
Sheets option should automatically be selected on the Print dialog box) on
the menu bar in order to print them be simpler?
 
C

CurlyDave

Thanks for the reply Rick,

The original intent was to create the list of Worksheets in the
UserForm then instead of printing them I wanted to create a new
workbook with the selected sheets and thought that this UserForm code
would work best for that.
I wanted first to have the UserForm show all the sheets, then I was
going to work on creating a workbook with the selected sheets.
 
C

CurlyDave

Why not use a userform (not a dialog sheet) and a scrolling listbox?
Click to expand...

Excellent, I have made a user form that lists all the sheets in a list
box and the selected sheets go to ListBox2.
I have the print selected sheets working, and the delete selected
Private Sub CommandButton3_Click()
'PRINTS SHEETS
Dim i As Integer
Dim s As String
Application.DisplayAlerts = False
For i = 1 To ListBox2.ListCount
s = ListBox2.List(i - 1)
Worksheets(s).PrintOut
Next i
Application.DisplayAlerts = True
Unload Me
End Sub

Private Sub CommandButton4_Click()
'DELETES SHEETS
Dim i As Integer
Dim s As String
Application.DisplayAlerts = False
For i = 1 To ListBox2.ListCount
s = ListBox2.List(i - 1)
Worksheets(s).Delete
Next i
Application.DisplayAlerts = True
Unload Me

End Sub
But I am having problems with adding a workbook and move the selected
sheets to the new workbook, I can get it to work individually, but
would like all selected sheets in the new workbook

'--------------------------------------------------------------------------
Private Sub CommandButton5_Click()
'Send to new WorkBook
Dim i As Integer
Dim s As String
Application.DisplayAlerts = False
For i = 1 To ListBox2.ListCount
s = ListBox2.List(i - 1)
Worksheets(s).Move

ActiveWorkbook.SaveAs Filename:="C:\Backup\" & _
Format(Date, "yyyy mm dd"), FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False


Workbooks("SelectSheetsUserForm.xls").Activate

Next i
Application.DisplayAlerts = True
Unload Me

End Sub

'----------------------------------------------------------
 
D

Dave Peterson

I put a listbox, a label, and 4 commandbuttons on a userform.

This was the code behind the userform:

Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Call ProcessSheets(Me.CommandButton2.Tag)
End Sub
Private Sub CommandButton3_Click()
Call ProcessSheets(Me.CommandButton3.Tag)
End Sub
Private Sub CommandButton4_Click()
Call ProcessSheets(Me.CommandButton4.Tag)
End Sub
Private Sub ListBox1_Change()

Dim lCtr As Long
Dim OkToEnableBtns As Boolean

OkToEnableBtns = False
With Me.ListBox1
For lCtr = 0 To .ListCount - 1
If .Selected(lCtr) = True Then
OkToEnableBtns = True
Exit For
End If
Next lCtr
End With

Me.CommandButton2.Enabled = OkToEnableBtns
Me.CommandButton3.Enabled = OkToEnableBtns
Me.CommandButton4.Enabled = OkToEnableBtns

End Sub
Private Sub UserForm_Initialize()

Dim sCtr As Long
Dim ActWkbk As Workbook

Set ActWkbk = ActiveWorkbook

With Me.ListBox1
.Clear
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
End With

With Me.CommandButton1
.Caption = "Cancel"
.Cancel = True
.TakeFocusOnClick = False
.Enabled = True
End With

With Me.CommandButton2
.Tag = "Print"
.Caption = "Print"
.ControlTipText = "Print the selected sheets"
.Enabled = False
End With

With Me.CommandButton3
.Tag = "Delete"
.Caption = "Delete"
.ControlTipText = "Delete the selected sheets"
.Enabled = False
End With

With Me.CommandButton4
.Tag = "Move"
.Caption = "Move"
.ControlTipText = "Move the selected sheets to a new workbook"
.Enabled = False
End With

With Me.Label1
.Caption = "Select some sheets"
End With

With ActWkbk
ReDim sArr(.Sheets.Count)
For sCtr = 1 To .Sheets.Count
Me.ListBox1.AddItem .Sheets(sCtr).Name
Next sCtr
End With

End Sub
Sub ProcessSheets(myOpt As String)
Dim nCtr As Long
Dim sCtr As Long
Dim myNames() As String
Dim ActWkbk As Workbook

Set ActWkbk = ActiveWorkbook

Me.Label1.Caption = ""

sCtr = 0
With Me.ListBox1
ReDim myNames(1 To .ListCount)
For nCtr = 0 To .ListCount - 1
If .Selected(nCtr) = True Then
sCtr = sCtr + 1
myNames(sCtr) = .List(nCtr)
End If
Next nCtr
End With

If sCtr = 0 Then
Me.Label1.Caption = "Select Some Sheets!"
Beep
Else
ReDim Preserve myNames(1 To sCtr)

Select Case LCase(myOpt)
Case Is = LCase("Print")
Me.Hide
ActWkbk.Sheets(myNames).PrintOut preview:=True
Me.Show
Case Is = LCase("Move")
Application.DisplayAlerts = False
On Error Resume Next
ActWkbk.Sheets(myNames).Move
If Err.Number <> 0 Then
Me.Label1.Caption = Err.Description
Err.Clear
Beep
Else
ActWkbk.Activate
Call UserForm_Initialize
End If
On Error GoTo 0
Application.DisplayAlerts = True
Case Is = LCase("Delete")
Application.DisplayAlerts = False
On Error Resume Next 'one sheet needs to be visible
ActWkbk.Sheets(myNames).Delete
If Err.Number <> 0 Then
Me.Label1.Caption = Err.Description
Err.Clear
Beep
Else
Call UserForm_Initialize
End If
On Error GoTo 0
Application.DisplayAlerts = True
Case Else
'this shouldn't happen
Me.Label1.Caption = "Please call CD at ####"
End Select
End If

End Sub
 
D

Dave Peterson

If you want to make this a little more generic...

I'd save it as an addin and create a toolbar that shows the form. Then the
addin could be loaded (via tools|addins in xl2003) or even just when you want
(via file|open).

I added a couple more options:
A copy button, a select all button, and an unselect all button.

This code creates the toolbar (xl2003 and below). It's placed in a General
module--not behind the userform and not behind ThisWorkbook and not behind a
worksheet.

Option Explicit
Public Const ToolBarName As String = "Multiple Sheet Selector"
Private Sub Auto_Open()
Call CreateMenubar
End Sub
Private Sub Auto_Close()
Call RemoveMenubar
End Sub
Private Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Private Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("ShowSheetSelectorForm")

CapNames = Array("Show Sheet Selector")

TipText = Array("Run this to print, move, copy or delete sheets")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNames(iCtr)
.Style = msoButtonCaption
.TooltipText = TipText(iCtr)
End With
Next iCtr

End With
End Sub
Sub ShowSheetSelectorForm()
UserForm1.Show
End Sub

==============
The userform now has 7 buttons, 1 label and a listbox.

This is the code behind the userform:

Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Call ProcessSheets(Me.CommandButton2.Tag)
End Sub
Private Sub CommandButton3_Click()
Call ProcessSheets(Me.CommandButton3.Tag)
End Sub
Private Sub CommandButton4_Click()
Call ProcessSheets(Me.CommandButton4.Tag)
End Sub
Private Sub CommandButton5_Click()
Call ProcessSheets(Me.CommandButton5.Tag)
End Sub
Private Sub commandbutton6_Click()
Dim iCtr As Long
With Me.ListBox1
For iCtr = 0 To .ListCount - 1
.Selected(iCtr) = True
Next iCtr
End With
End Sub
Private Sub commandbutton7_Click()
Dim iCtr As Long
With Me.ListBox1
For iCtr = 0 To .ListCount - 1
.Selected(iCtr) = False
Next iCtr
End With
End Sub
Private Sub ListBox1_Change()

Dim lCtr As Long
Dim HowManyChecked

HowManyChecked = 0
With Me.ListBox1
For lCtr = 0 To .ListCount - 1
If .Selected(lCtr) = True Then
HowManyChecked = HowManyChecked + 1
End If
Next lCtr

Me.CommandButton2.Enabled _
= CBool(HowManyChecked > 0)

Me.CommandButton3.Enabled _
= (CBool(HowManyChecked > 0) _
And CBool(HowManyChecked < .ListCount))
Me.CommandButton4.Enabled _
= (CBool(HowManyChecked > 0) _
And CBool(HowManyChecked < .ListCount))

Me.CommandButton5.Enabled _
= CBool(HowManyChecked > 0)

Me.CommandButton6.Enabled _
= CBool(HowManyChecked < .ListCount)

Me.CommandButton7.Enabled _
= CBool(HowManyChecked > 0)

End With
End Sub
Private Sub UserForm_Initialize()

Dim sCtr As Long
Dim ActWkbk As Workbook

Set ActWkbk = ActiveWorkbook

Me.Caption = "Sheet Selector"

With Me.ListBox1
.Clear
.MultiSelect = fmMultiSelectMulti
.ListStyle = fmListStyleOption
End With

With Me.CommandButton1
.Caption = "Cancel"
.Cancel = True
.TakeFocusOnClick = False
.Enabled = True
End With

With Me.CommandButton2
.Tag = "Print"
.Caption = "Print"
.ControlTipText = "Print the selected sheets"
.Enabled = False
End With

With Me.CommandButton3
.Tag = "Delete"
.Caption = "Delete"
.ControlTipText = "Delete the selected sheets"
.Enabled = False
End With

With Me.CommandButton4
.Tag = "Move"
.Caption = "Move"
.ControlTipText = "Move the selected sheets to a new workbook"
.Enabled = False
End With

With Me.CommandButton5
.Tag = "Copy"
.Caption = "Copy"
.ControlTipText = "Copy the selected sheets to a new workbook"
.Enabled = False
End With

With Me.CommandButton6
.Tag = "SelectAll"
.Caption = "Select" & vbLf & "All"
.Enabled = True
End With

With Me.CommandButton7
.Tag = "UnSelectAll"
.Caption = "UnSelect" & vbLf & "All"
.Enabled = False
End With

With Me.Label1
.Caption = "Select some sheets"
.ForeColor = vbRed
.WordWrap = True
End With

With ActWkbk
ReDim sArr(.Sheets.Count)
For sCtr = 1 To .Sheets.Count
Me.ListBox1.AddItem .Sheets(sCtr).Name
Next sCtr
End With

End Sub
Sub ProcessSheets(myOpt As String)
Dim nCtr As Long
Dim sCtr As Long
Dim myNames() As String
Dim ActWkbk As Workbook

Set ActWkbk = ActiveWorkbook

Me.Label1.Caption = ""

sCtr = 0
With Me.ListBox1
ReDim myNames(1 To .ListCount)
For nCtr = 0 To .ListCount - 1
If .Selected(nCtr) = True Then
sCtr = sCtr + 1
myNames(sCtr) = .List(nCtr)
End If
Next nCtr
End With

If sCtr = 0 Then
Me.Label1.Caption = "Select Some Sheets!"
Beep
Else
ReDim Preserve myNames(1 To sCtr)

Select Case LCase(myOpt)
Case Is = LCase("Print")
Me.Hide
ActWkbk.Sheets(myNames).PrintOut preview:=True
Me.Show
Case Is = LCase("Move")
Application.DisplayAlerts = False
On Error Resume Next
ActWkbk.Sheets(myNames).Move
If Err.Number <> 0 Then
Me.Label1.Caption = "Move failed!" & vbLf & Err.Description
Err.Clear
Beep
Else
ActWkbk.Activate
Call UserForm_Initialize
End If
On Error GoTo 0
Application.DisplayAlerts = True
Case Is = LCase("Copy")
Application.DisplayAlerts = False
On Error Resume Next
ActWkbk.Sheets(myNames).Copy
If Err.Number <> 0 Then
Me.Label1.Caption = "Copy Failed" & vbLf & Err.Description
Err.Clear
Beep
Else
ActWkbk.Activate
End If
On Error GoTo 0
Application.DisplayAlerts = True
Case Is = LCase("Delete")
Application.DisplayAlerts = False
On Error Resume Next 'one sheet needs to be visible
ActWkbk.Sheets(myNames).Delete
If Err.Number <> 0 Then
Me.Label1.Caption = "Delete Failed" & vblf & Err.Description
Err.Clear
Beep
Else
Call UserForm_Initialize
End If
On Error GoTo 0
Application.DisplayAlerts = True
Case Else
'this shouldn't happen
Me.Label1.Caption = "Please call CD at ####"
End Select
End If

End Sub

=============
If you're using xl2007, this toolbar will show up in the Addins Tab/Group.

If you want to learn about modifying the ribbon, you can start at Ron de Bruin's
site:
http://www.rondebruin.nl/ribbon.htm
http://www.rondebruin.nl/qat.htm -- For macros for all workbooks (saved as an
addin)
or
http://www.rondebruin.nl/2007addin.htm
 
D

Dave Peterson

ps.

Remember that I did a print preview--you may want to change that if you don't
want to print from the preview window.
 
R

Ricardo Strachan

Great work thanks.
I'm stumped with trying to add an additional feature as follows:
- I have seperate word docs with descriptive text asigned to each worksheet.
- I would like to build the relevant doc into the report only when the relevant worksheet is selected.
- That is; Say Sheet1 and Sheet2 are selected, then Doc1 and Doc2 are drawn into the report for printing.
Is this possible?
Cheers



Posted as a reply to:

Re: Select Sheets to Print

Got that, Thanks
Works Very Well Indeed.

EggHeadCafe - Software Developer Portal of Choice
WCF Workflow Services Using External Data Exchange
http://www.eggheadcafe.com/tutorial...a-6dafb17b6d74/wcf-workflow-services-usi.aspx
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Email selected sheets 5
Print multiple sheets from checkboxes into one pdf 0
How do I add the ability to select the number of printed pages to aDialog Sheet 2
Calling JJ re generate form at runtime 0
Resize msgbox windows 2
Dialogsheet Checkbox to Select All Checkboxes 0
Auto select worksheets - and goto a specific cell afterwards 2
Change looping process to ignore certain sheets 6

Top