Select Sheets to Print
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? |
Select Sheets to Print
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? -- Rick (MVP - Excel) "CurlyDave" wrote in message ... 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? |
Select Sheets to Print
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. |
Select Sheets to Print
Just bringing this thread back up....
|
Select Sheets to Print
Why not use a userform (not a dialog sheet) and a scrolling listbox?
CurlyDave wrote: Just bringing this thread back up.... -- Dave Peterson |
Select Sheets to Print
On Feb 19, 8:02*pm, Dave Peterson wrote:
Why not use a userform (not a dialog sheet) and a scrolling listbox? CurlyDave wrote: Just bringing this thread back up.... -- Dave Peterson 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 '---------------------------------------------------------- |
Select Sheets to Print
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 CurlyDave wrote: On Feb 19, 8:02 pm, Dave Peterson wrote: Why not use a userform (not a dialog sheet) and a scrolling listbox? CurlyDave wrote: Just bringing this thread back up.... -- Dave Peterson 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 '---------------------------------------------------------- -- Dave Peterson |
Select Sheets to Print
Thanks Dave,
It worked the very first time just as you said.... Here's a link to the Workbook for others to see. http://sites.google.com/site/davesex...attredirects=0 |
Select Sheets to Print
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 CurlyDave wrote: Thanks Dave, It worked the very first time just as you said.... Here's a link to the Workbook for others to see. http://sites.google.com/site/davesex...attredirects=0 -- Dave Peterson |
Select Sheets to Print
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. CurlyDave wrote: Thanks Dave, It worked the very first time just as you said.... Here's a link to the Workbook for others to see. http://sites.google.com/site/davesex...attredirects=0 -- Dave Peterson |
Select Sheets to Print
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. Dave Peterson Got that, Thanks, Works Very Well Indeed. |
Select Sheets to Print
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: 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/tutorials...vices-usi.aspx |
All times are GMT +1. The time now is 06:53 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com