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