Solved: Select printer & sheet code modification

[sujittalukde]

I have found some codes and modified the same but not getting the desired result.As my knowledge in VBA is limited to copy/paste I need help of seniors. the code is represented below:

 
Sub SelectPrinterAndSheets()
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
Application.Dialogs(xlDialogPrinterSetup).Show
' 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 problems & modification reqd. are given below:

1. If you run the code you will first get a menu to select printer. Then whether you press "cancel " or "OK" you will be ahown the seklect sheets to print dialog. I wnat that if the user clicks cancel "select sheets to print" dialog should not appear.

2. "Selesct sheets to print " dialog will take you to last sheet even if you press it from any other sheet say sheet1 or sheet2 etc. I want that the code should not go to l;ast sheet and should stay on the sheet from where the user has run the code.

3. this code does not show hidden sheets . I want that this should show hidden sheets also to print & should actually take print if users select the sheet & click print.(hidden sheets means normally hidden sheets from excel menu Format\sheet\hide) But should not show very hidden sheets done through macro.


4. I want that the dialog should not show one specific sheet whether hidden or not named "extract".

A sample workbook is posted for testing purpose.

[Bob Phillips]

[vba]

Option Explicit

Sub SelectPrinterAndSheets()
Dim i As Long
Dim TopPos As Long
Dim SheetCount As Long
Dim iCheckBox As Long
Dim iHidden As Long
Dim PrintDlg As DialogSheet
Dim cb As CheckBox
Dim dlgResult
Dim aryHidden

Application.ScreenUpdating = False
ReDim aryHidden(1 To 1)
dlgResult = Application.Dialogs(xlDialogPrinterSetup).Show
' Check for protected workbook
If dlgResult <> "False" Then
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
' Add a temporary dialog sheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = Worksheets.Count
' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
' Skip empty sheets and hidden sheets
If Application.CountA(Worksheets(i).Cells) <> 0 And _
Worksheets(i).Name <> "Extract" Then

If Worksheets(i).Visible = xlSheetHidden Then

iHidden = iHidden + 1
ReDim Preserve aryHidden(1 To iHidden)
aryHidden(iHidden) = Worksheets(i).Name
Worksheets(i).Visible = xlSheetVisible
End If

SheetCount = SheetCount + 1
iCheckBox = iCheckBox + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(iCheckBox).Text = _
Worksheets(i).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
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
'rehide sheets
For i = 1 To iHidden
Worksheets(aryHidden(i)).Visible = xlSheetHidden
Next i
' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
End If
End Sub
[/vba]

[sujittalukde]

Really fantastic!!!!!!!!!!!!!!
A separate dialog file comes into picture when the code run. Can this be fixed? In the background ,can the sheet from where the code is run be seen instead of the background as now showing???

[Bob Phillips]

[vba]


Option Explicit

Sub SelectPrinterAndSheets()
Dim i As Long
Dim TopPos As Long
Dim SheetCount As Long
Dim iCheckBox As Long
Dim iHidden As Long
Dim PrintDlg As DialogSheet
Dim cb As CheckBox
Dim dlgResult
Dim aryHidden

Application.ScreenUpdating = False
ReDim aryHidden(1 To 1)
dlgResult = Application.Dialogs(xlDialogPrinterSetup).Show
' Check for protected workbook
If dlgResult <> "False" Then
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
' Add a temporary dialog sheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
PrintDlg.Visible = xlSheetHidden
SheetCount = Worksheets.Count
' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
' Skip empty sheets and hidden sheets
If Application.CountA(Worksheets(i).Cells) <> 0 And _
Worksheets(i).Name <> "Extract" Then

If Worksheets(i).Visible = xlSheetHidden Then

iHidden = iHidden + 1
ReDim Preserve aryHidden(1 To iHidden)
aryHidden(iHidden) = Worksheets(i).Name
Worksheets(i).Visible = xlSheetVisible
End If

SheetCount = SheetCount + 1
iCheckBox = iCheckBox + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(iCheckBox).Text = _
Worksheets(i).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
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
'rehide sheets
For i = 1 To iHidden
Worksheets(aryHidden(i)).Visible = xlSheetHidden
Next i
' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete
End If
End Sub
[/vba]

[sujittalukde]

Thats really fantastic!
Code is fully modeified

Very thanks xld.

[tcambridge]

Is there a way to include only Active and visible sheets? Don't count anything greater than -1?

[vba] Option Explicit Sub SelectPrinterAndSheets() Dim i As Long Dim TopPos As Long Dim SheetCount As Long Dim iCheckBox As Long Dim iHidden As Long Dim PrintDlg As DialogSheet Dim cb As CheckBox Dim dlgResult Dim aryHidden Application.ScreenUpdating = False ReDim aryHidden(1 To 1) dlgResult = Application.Dialogs(xlDialogPrinterSetup).Show ' Check for protected workbook If dlgResult "False" Then If ActiveWorkbook.ProtectStructure Then MsgBox "Workbook is protected.", vbCritical Exit Sub End If ' Add a temporary dialog sheet Set PrintDlg = ActiveWorkbook.DialogSheets.Add PrintDlg.Visible = xlSheetHidden SheetCount = Worksheets.Count ' Add the checkboxes TopPos = 40 For i = 1 To ActiveWorkbook.Worksheets.Count ' Skip empty sheets and hidden sheets If Application.CountA(Worksheets(i).Cells) 0 And _ Worksheets(i).Name "Extract" Then If Worksheets(i).Visible = xlSheetHidden Then iHidden = iHidden + 1 ReDim Preserve aryHidden(1 To iHidden) aryHidden(iHidden) = Worksheets(i).Name Worksheets(i).Visible = xlSheetVisible End If SheetCount = SheetCount + 1 iCheckBox = iCheckBox + 1 PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5 PrintDlg.CheckBoxes(iCheckBox).Text = _ Worksheets(i).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 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 'rehide sheets For i = 1 To iHidden Worksheets(aryHidden(i)).Visible = xlSheetHidden Next i ' Delete temporary dialog sheet (without a warning) Application.DisplayAlerts = False PrintDlg.Delete End IfEnd Sub[/vba]

[Bob Phillips]

Public Sub SelectPrinterAndSheets()
Const nPerColumn As Long = 16 'number of items per column
Const nWidth As Long = 13 'width of each letter
Const nHeight As Long = 16 'height of each row
Const sID As String = "___SheetGoto" 'name of dialog sheet
Const kCaption As String = " Select worksheet to goto" 'dialog caption
 
Dim i As Long
Dim SheetCount As Long
Dim TopPos As Long
Dim iBooks As Long
Dim iCheckBox As Long
Dim cCols As Long
Dim cLeft As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iHidden As Long
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Dim ws As Worksheet
Dim aryHidden As Variant
Dim dlgResult As Variant
 
    Application.ScreenUpdating = False
     
    ReDim aryHidden(1 To 1)
    dlgResult = Application.Dialogs(xlDialogPrinterSetup).Show
     ' Check for protected workbook
    If dlgResult <> "False" Then
    
        If ActiveWorkbook.ProtectStructure Then
            MsgBox "Workbook is protected.", vbCritical
            Exit Sub
        End If
        
         ' Add a temporary dialog sheet
        Set PrintDlg = ActiveWorkbook.DialogSheets.Add
        PrintDlg.Visible = xlSheetHidden
 
        With PrintDlg
         
            .Name = sID
            .Visible = xlSheetHidden
             
            'sets variables for positioning on dialog
            iBooks = 0
            cCols = 0
            cMaxLetters = 0
            cLeft = 78
            TopPos = 40
            For i = 1 To ActiveWorkbook.Worksheets.Count
            
                 ' Skip empty sheets and hidden sheets
                If Application.CountA(Worksheets(i).Cells) <> 0 Then
                             
                    If Worksheets(i).Visible = xlSheetHidden Then
                         
                        iHidden = iHidden + 1
                        ReDim Preserve aryHidden(1 To iHidden)
                        aryHidden(iHidden) = Worksheets(i).Name
                        Worksheets(i).Visible = xlSheetVisible
                        
                    Else
                    
                        If (SheetCount + 1) Mod nPerColumn = 1 Then
                        
                            cCols = cCols + 1
                            TopPos = 40
                            cLeft = cLeft + (cMaxLetters * nWidth)
                            cMaxLetters = 0
                        End If

                        cLetters = Len(ActiveWorkbook.Worksheets(i).Name)
                        If cLetters > cMaxLetters Then cMaxLetters = cLetters
    
                        SheetCount = SheetCount + 1
                        iCheckBox = iCheckBox + 1
                        PrintDlg.CheckBoxes.Add cLeft, TopPos, 150, 16.5
                        PrintDlg.CheckBoxes(iCheckBox).Text = Worksheets(i).Name
                        TopPos = TopPos + 13
                    End If
                End If
            Next i
         
            .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 74
             
            With .DialogFrame
            
                .Height = Application.Max(68, Application.Min(SheetCount, nPerColumn) * nHeight + 10)
                .Width = cLeft + (cMaxLetters * nWidth) + 74
                .Caption = kCaption
            End With
         
            .Buttons("Button 2").BringToFront
            .Buttons("Button 3").BringToFront
         
            Application.ScreenUpdating = True
            If .Show Then
            
                For Each cb In PrintDlg.OptionButtons
                
                    If cb.Value = xlOn Then
                    
                        ActiveWorkbook.Worksheets(cb.Caption).Select
                        Exit For
                    End If
                Next cb
            Else
            
                MsgBox "Nothing selected"
            End If
         
            Application.DisplayAlerts = False
            .Delete
        End With
    End If
End Sub

[tcambridge]

Somehow this code still pick up all the xlSheetVeryHidden ones. Is there a way to exclude those xlSheetHidden and xlSheetVeryHidden at the same time? Thanks so much.

[Bob Phillips]

When you say picks up, do you mean that they get listed? they were excluded in my tests.

[tcambridge]

yes, they get listed in my test. The ones, that are Visible = 0 - xlSheetHidden, are NOT listed. However, the ones, that are Visible = 2 - xlSheetVeryHidden, are listed.