Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Hello,
I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Send the separate sheets to separate addressees:
http://www.rondebruin.nl/mail/folder2/files.htm Call the second macro from the first macro: Sub Macro1() Msgbox("This is Macro1") Call Macro2 'This calls for Macro2 to run End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "DavidH56" wrote: Hello, I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Thanks for your quick response ryguy7272,
I tried your suggestion of calling the second macro replacing If cb.Value = xlOn Then Worksheets(cb.Caption).Activate ActiveSheet.PrintOut ' ActiveSheet.PrintPreview 'for debugging End If with If cb.Value = xlOn Then Worksheets(cb.Caption).Activate Call Mail_ThisWorkSheet ' ActiveSheet.PrintPreview 'for debugging End If but I could not get it to work. I thought if I could just change this portion of the code from send to the printer to send those sheets that were selected with the checkboxes to each appropriate address listed in cell A1. thanks also I'm using Outlook Express. Thanks again for your response -- By persisting in your path, though you forfeit the little, you gain the great. "ryguy7272" wrote: Send the separate sheets to separate addressees: http://www.rondebruin.nl/mail/folder2/files.htm Call the second macro from the first macro: Sub Macro1() Msgbox("This is Macro1") Call Macro2 'This calls for Macro2 to run End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "DavidH56" wrote: Hello, I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Hi David
If you want send me your test workbook with your test code and I take a look at it for you You can find my mail address on my site http://www.rondebruin.nl/ -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "DavidH56" wrote in message ... Thanks for your quick response ryguy7272, I tried your suggestion of calling the second macro replacing If cb.Value = xlOn Then Worksheets(cb.Caption).Activate ActiveSheet.PrintOut ' ActiveSheet.PrintPreview 'for debugging End If with If cb.Value = xlOn Then Worksheets(cb.Caption).Activate Call Mail_ThisWorkSheet ' ActiveSheet.PrintPreview 'for debugging End If but I could not get it to work. I thought if I could just change this portion of the code from send to the printer to send those sheets that were selected with the checkboxes to each appropriate address listed in cell A1. thanks also I'm using Outlook Express. Thanks again for your response -- By persisting in your path, though you forfeit the little, you gain the great. "ryguy7272" wrote: Send the separate sheets to separate addressees: http://www.rondebruin.nl/mail/folder2/files.htm Call the second macro from the first macro: Sub Macro1() Msgbox("This is Macro1") Call Macro2 'This calls for Macro2 to run End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "DavidH56" wrote: Hello, I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Hi David
You call a wrong macro Use this macro if you use OE http://www.rondebruin.nl/mail/folder1/mail2.htm I changed a few things for you (body is not possible) Sub Mail_ActiveSheet() 'Working in 97-2007 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheet to a new workbook ActiveSheet.Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007, we exit the sub when your answer is 'NO in the security dialog that you only see when you copy 'an sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' 'Change all cells in the worksheet to values if you want ' With Destwb.Sheets(1).UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next .SendMail ActiveSheet.Range("A1").Value, _ "AV Ministry Financial Updates" On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub And use Call Mail_ActiveSheet -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Hi David If you want send me your test workbook with your test code and I take a look at it for you You can find my mail address on my site http://www.rondebruin.nl/ -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "DavidH56" wrote in message ... Thanks for your quick response ryguy7272, I tried your suggestion of calling the second macro replacing If cb.Value = xlOn Then Worksheets(cb.Caption).Activate ActiveSheet.PrintOut ' ActiveSheet.PrintPreview 'for debugging End If with If cb.Value = xlOn Then Worksheets(cb.Caption).Activate Call Mail_ThisWorkSheet ' ActiveSheet.PrintPreview 'for debugging End If but I could not get it to work. I thought if I could just change this portion of the code from send to the printer to send those sheets that were selected with the checkboxes to each appropriate address listed in cell A1. thanks also I'm using Outlook Express. Thanks again for your response -- By persisting in your path, though you forfeit the little, you gain the great. "ryguy7272" wrote: Send the separate sheets to separate addressees: http://www.rondebruin.nl/mail/folder2/files.htm Call the second macro from the first macro: Sub Macro1() Msgbox("This is Macro1") Call Macro2 'This calls for Macro2 to run End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "DavidH56" wrote: Hello, I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email selected sheets
Thank you Ron for your time and your expertise. This works to perfectly.
-- By persisting in your path, though you forfeit the little, you gain the great. "Ron de Bruin" wrote: Hi David You call a wrong macro Use this macro if you use OE http://www.rondebruin.nl/mail/folder1/mail2.htm I changed a few things for you (body is not possible) Sub Mail_ActiveSheet() 'Working in 97-2007 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheet to a new workbook ActiveSheet.Copy Set Destwb = ActiveWorkbook 'Determine the Excel version and file extension/format With Destwb If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007, we exit the sub when your answer is 'NO in the security dialog that you only see when you copy 'an sheet from a xlsm file with macro's disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "Your answer is NO in the security dialog" Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' 'Change all cells in the worksheet to values if you want ' With Destwb.Sheets(1).UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next .SendMail ActiveSheet.Range("A1").Value, _ "AV Ministry Financial Updates" On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub And use Call Mail_ActiveSheet -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... Hi David If you want send me your test workbook with your test code and I take a look at it for you You can find my mail address on my site http://www.rondebruin.nl/ -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "DavidH56" wrote in message ... Thanks for your quick response ryguy7272, I tried your suggestion of calling the second macro replacing If cb.Value = xlOn Then Worksheets(cb.Caption).Activate ActiveSheet.PrintOut ' ActiveSheet.PrintPreview 'for debugging End If with If cb.Value = xlOn Then Worksheets(cb.Caption).Activate Call Mail_ThisWorkSheet ' ActiveSheet.PrintPreview 'for debugging End If but I could not get it to work. I thought if I could just change this portion of the code from send to the printer to send those sheets that were selected with the checkboxes to each appropriate address listed in cell A1. thanks also I'm using Outlook Express. Thanks again for your response -- By persisting in your path, though you forfeit the little, you gain the great. "ryguy7272" wrote: Send the separate sheets to separate addressees: http://www.rondebruin.nl/mail/folder2/files.htm Call the second macro from the first macro: Sub Macro1() Msgbox("This is Macro1") Call Macro2 'This calls for Macro2 to run End Sub -- Ryan--- If this information was helpful, please indicate this by clicking ''Yes''. "DavidH56" wrote: Hello, I came across some fabulous code by Dave Peterson which allows me to print out selected sheets based on checkbox selections. Could someone please assist me to call a separate macro which I have to send the separate sheets to separate addressees instead of printing the sheets. My sendmail macro (called Mail_ActiveSheet) currently sends the activesheet having the email address in cell A1. I think I got this from Ron Debruin's site. Please see Dave's code below. 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 Dim curWkbk As Workbook Application.ScreenUpdating = False Set curWkbk = ActiveWorkbook ' 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 = Workbooks.Add.DialogSheets.Add SheetCount = 0 ' Add the checkboxes TopPos = 40 For i = 1 To curWkbk.Worksheets.Count Set CurrentSheet = curWkbk.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 curWkbk.Close savechanges:=False ' Reactivate original sheet CurrentSheet.Activate End Sub Thank you in advance for your assistance. -- By persisting in your path, though you forfeit the little, you gain the great. . |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Email selected tabs of spreadsheet? | Excel Discussion (Misc queries) | |||
How to repeat a code for selected sheets (or a contiguous range of sheets) in a Workbook? | Excel Worksheet Functions | |||
How to repeat a code for selected sheets (or a contiguous range of sheets) in a Workbook? | Excel Programming | |||
Email selected range in Excel | Excel Programming |