PDA

View Full Version : [SOLVED] Problem with Print All Sheets



tcambridge
08-07-2014, 08:23 AM
I found this VBA code from this forum. There are two problems that I am facing when using this code:


After running the code, all hidden sheets are being changed to xlSheetVisible automatically and stay visible.
Nothing is being printed out


Can you please help? Thank you so much.

Option Explicit
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

westconn1
08-07-2014, 02:33 PM
assuming you do not want to print hidden sheets, remove
Worksheets(i).Visible = xlSheetVisible

are you actually using any of the features of the created dialog worksheet?

somewhere you need worksheets(i).printout, to actually print each worksheet

a more basic code to print all sheets

for each ws in worksheets
if ws.visible = xlsheetvisible then ws.printout
nextthis does not include any settings of printarea, margins etc

if you want to print hidden sheets as well
try like

for each ws in worksheets
tmpvis = ws.visible
ws.visible = xlsheetvisible
ws.printout
ws.visible = tmpvis
next

tcambridge
08-08-2014, 08:53 AM
Thank you for your posting Westconn1. However, it printed out ALL Visible sheets instead of selected sheets only. I wanted to print multiple selected sheets only and not hidden sheets. Can you please help? Thank you.

p45cal
08-08-2014, 11:25 AM
try:
Option Explicit
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, SheetsToPrint(), SheetCount As Long
Dim PrintCount 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 cb As CheckBox
Dim aryHidden As Variant
Dim dlgResult As Variant

Application.ScreenUpdating = False
ReDim SheetsToPrint(0)
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
PrintCount = 0
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
ReDim Preserve SheetsToPrint(PrintCount)
SheetsToPrint(UBound(SheetsToPrint)) = cb.Caption
PrintCount = PrintCount + 1
End If
Next cb
If PrintCount > 0 Then
Sheets(SheetsToPrint).PrintOut Copies:=1, preview:=True, Collate:=True, IgnorePrintAreas:=False 'miss out the preview:=True to avoid the print preview.
Else
MsgBox "Nothing selected"
End If
Else
MsgBox "Nothing selected"
End If
Application.DisplayAlerts = False
.Delete
End With
End If
End Sub

tcambridge
08-08-2014, 11:52 AM
Thank you so much! It works perfectly! :bow::bow: