Select sheet to print from a drop down box

K

krislyn

Hi All,
I Have a workbook where each tab is a different months report.
Would like a print button on a menu that lets the user click and choos
from the available tabs in the workbook to print.
I'm not good at drop downs yet......thanks

Krisly
 
R

Ron de Bruin

Try this

You can use a userform
Add a listbox and a button on the userform
In the properties of the listbox set Multiselect to 1

Add this code in the Userform module

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 ThisWorkbook.Sheets
If ws.Visible = True Then
Me.ListBox1.AddItem (ws.Name)
End If
Next
End Sub
 
K

krislyn

Ron,

I tried your code and I am getting an error message that says
"invalid use of Me keyword" when trying to initialize the form.

krisly
 
R

Ron de Bruin

Hi krislyn

Have your listbox the name ListBox1 ?
If Yes send me your test workbook and i take a look at it.
 
K

krislyn

Ron,

So do I have to create a listbox?
I am not savvy on creating these. Not sure how.




Thanks
from very junior member!
krisly
 
B

Bob Phillips

Take a look at my suggestion, it is a fully working solution.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
B

Byers

I'm working on a similair print macro, my workbook is protected, in tha
solution with the link it seems that if the workbook is protected i
won't print. What's the deal with that?
*I sort of skipped a few steps in learning VBA with exce
 
B

Byers

I got it figured out with a few alterations to the code to jus
unprotect when starting and protect when finished, thanks for the cod
though
 
K

krislyn

The original suggested code from Bob Phillips works fine (link to Joh
Walenback), except that I have graph sheets in the workbook also. Whe
the print menu appears it only displays the month sheets. How can I ad
code so the graph tabs display on the print menu as well?
Thanks!!!
Krisly
 
B

Bob Phillips

Krislyn,

Change the lines

For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)

to

For i = 1 To ActiveWorkbook.Sheets.Count
Set CurrentSheet = ActiveWorkbook.Sheets(i)


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
K

krislyn

Bob,

I changed the code per your suggestion and I am now getting a debu
message "Type Mismatch" on the line

Set CurrentSheet = ActiveWorkbook.Sheets(i)

Is it because in the first few lines of the code it states

Dim CurrentSheet As Worksheet?

Thanks
Krisly
 
B

Bob Phillips

Krislyn,

Nice spot. I think that is the problem, but you can't change it to Sheet as
there is no such variable type, so just use

Dim CurrentSheet

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
K

krislyn

Now I get a message: "Object does not support this property or method"
at the lines....
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then


Here is the code I have:

Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet
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.Sheets.Count
Set CurrentSheet = ActiveWorkbook.Sheets(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


Thanks
Krislyn
 
B

Bob Phillips

Krislyn,

Problem is that there were tests that won't work on charts. I have amended
the code to cater for charts as well, so it should work now.
Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet
Dim cb As CheckBox
Dim fInclude As Boolean

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.Sheets.Count
Set CurrentSheet = ActiveWorkbook.Sheets(i)
fInclude = True
If CurrentSheet.Name = PrintDlg.Name Then
fInclude = False
ElseIf CurrentSheet.Visible <> xlSheetVisible Then
fInclude = False
ElseIf TypeName(CurrentSheet) = "Worksheet" Then
If Application.CountA(CurrentSheet.Cells) = 0 Then
fInclude = False
End If
End If
If fInclude 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




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
K

krislyn

Bob,

Thank you so much for your time helping me with this.
It works fine, but just one more fine tune and I will be out of you
hair(on this one anyway :-})

There are up to 55 sheets in the spreadsheet (2yrs of data + graphs)
The dialog box now goes down past the toolbar at the bottom.
Can we place them in columns, say 25 checkboxes per column so they al
display on the screen?
Thank you so much!

krislyn:
 
B

Bob Phillips

Fine tune! It's a new bloody song<G>

Give this a whirl, it's quite a bit different

Sub SelectSheets()
Dim i As Long
Dim iRows As Long
Dim TopPos As Long
Dim LeftPos As Long
Dim SheetCount As Long
Dim cMaxLetters As Long
Dim cLeftWidth As Long
Dim PrintDlg As DialogSheet
Dim CurrentSheet
Dim cb As CheckBox
Dim fInclude As Boolean
Dim arySheets

Application.ScreenUpdating = False

ReDim arySheets(0)

' 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

'first count the items that apply
For i = 1 To ActiveWorkbook.Sheets.Count
Set CurrentSheet = ActiveWorkbook.Sheets(i)
fInclude = True
If CurrentSheet.Name = PrintDlg.Name Then
fInclude = False
ElseIf CurrentSheet.Visible <> xlSheetVisible Then
fInclude = False
ElseIf TypeName(CurrentSheet) = "Worksheet" Then
If Application.CountA(CurrentSheet.Cells) = 0 Then
fInclude = False
End If
End If
If fInclude Then
SheetCount = SheetCount + 1
ReDim Preserve arySheets(SheetCount)
arySheets(SheetCount) = CurrentSheet.Name
End If
Next i

If SheetCount = 0 Then
MsgBox "All worksheets are empty."
PrintDlg.Delete
Exit Sub
End If

iRows = Int((SheetCount + 1) / 2)

' Add the checkboxes
TopPos = 40
LeftPos = 78
For i = 1 To UBound(arySheets, 1)
With Sheets(arySheets(i))
If Len(.Name) > cMaxLetters Then
cMaxLetters = Len(.Name)
End If
TopPos = TopPos + 13
PrintDlg.CheckBoxes.Add LeftPos, TopPos, 150, 16.5
PrintDlg.CheckBoxes(i).Text = .Name
End With
If i = iRows Then
TopPos = 40
cLeftWidth = 30 + (cMaxLetters * 4) + 10 + 24 + 8 - 10
LeftPos = cLeftWidth + 78
cMaxLetters = 0
End If
Next i

' Move the OK and Cancel buttons
With PrintDlg
.Buttons.Left = cLeftWidth + 108 + (cMaxLetters * 4) + 10 + 24 + 8


' Set dialog height, width, and caption
With .DialogFrame
.Height = Application.Max(68, (iRows * 13) + 40)
.Width = 108 + (cMaxLetters * 4) + 10 + 24 + 8 - 10 + cLeftWidth
.Caption = "Select sheets to print"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If .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

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
.Delete
End With

' Reactivate original sheet
CurrentSheet.Activate
End Sub




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
K

krislyn

Bob is good...Bob is Great....thanks a bunch Mate!

Put to your own tune! (you don't want me to sing it!!)

Works Perfect!! Thank You so much!!


Have a great day!

krislyn:
 
Top