PDA

View Full Version : Solved: Select printer & sheet code modification



sujittalukde
06-03-2007, 10:07 PM
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
06-04-2007, 01:16 AM
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

sujittalukde
06-04-2007, 01:27 AM
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
06-04-2007, 01:40 AM
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

sujittalukde
06-04-2007, 05:07 AM
Thats really fantastic!
Code is fully modeified

Very thanks xld.

tcambridge
05-27-2014, 02:05 PM
Is there a way to include only Active and visible sheets? Don't count anything greater than -1?





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

Bob Phillips
05-28-2014, 07:40 AM
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
05-28-2014, 02:00 PM
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
05-28-2014, 03:44 PM
When you say picks up, do you mean that they get listed? they were excluded in my tests.

tcambridge
05-29-2014, 07:18 AM
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.