How can I get this code to work?

[Sam]

I have been trying for a day or 2 to get some code to
work which Tom Ogilvy posted for me which was an
adaptation of John Walkenbach's code.

I have a combo box, I have assigned the code (which I
have stored as a module to the combo box and it doesnt do
anything!!

Where am I going wrong?

This is the code

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items
per­ column
Const nWidth As Long = 7 'width of each
lette­r
Const nHeight As Long = 18 'height of each
row
Const sID As String = "___WorksheetPrint" 'name of
dialog shee­t
Const kCaption As String = " Select worksheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cLeft As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.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

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.ActiveSheet
cLetters = Len(ActiveWorkbook.Worksheets
(i).Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.CheckBoxes.Add cLeft, TopPos, cLetters *
nWidth, 16.5
.CheckBoxes(iBooks).Caption =
ActiveWorkbook.Worksheets(i).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cLeft + (cMaxLetters * nWidth) +
24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) *
nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets
(cb.Caption).PrintOut
End If
Next cb
Else
MsgBox "No sheets selected"
End If
Application.DisplayAlerts = False

.Delete

End With

End Sub

 

[Tom Ogilvy]

I copied the code out of your email and put it in a module (cleaned up the
word wrap) and ran it through Tools=>Macro=>Macros, selecting Printsheets
and hitting Run.

It put up a dialog box with each worksheet listed (in the activeworkbook)
with a check box next to each. I clicked two of the checkboxes and clicked
OK. It printout out the two sheets selected.

Again, if you don't run the code, it won't do anything. I am not sure why
you would assign it to a combobox (or what type of combobox or what you mean
by assign) as it is stand alone in terms of putting up an interface for the
user to select what sheets to print. Perhaps assign it to a button and then
click the button.

--
Regards,
Tom Ogilvy

I have been trying for a day or 2 to get some code to
work which Tom Ogilvy posted for me which was an
adaptation of John Walkenbach's code.

I have a combo box, I have assigned the code (which I
have stored as a module to the combo box and it doesnt do
anything!!

Where am I going wrong?

This is the code

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items
per­ column
Const nWidth As Long = 7 'width of each
lette­r
Const nHeight As Long = 18 'height of each
row
Const sID As String = "___WorksheetPrint" 'name of
dialog shee­t
Const kCaption As String = " Select worksheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cLeft As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox

Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add

With thisDlg

.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

If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If

Set CurrentSheet = ActiveWorkbook.ActiveSheet
cLetters = Len(ActiveWorkbook.Worksheets
(i).Name)
If cLetters > cMaxLetters Then
cMaxLetters = cLetters
End If

iBooks = iBooks + 1
.CheckBoxes.Add cLeft, TopPos, cLetters *
nWidth, 16.5
.CheckBoxes(iBooks).Caption =
ActiveWorkbook.Worksheets(i).Name
TopPos = TopPos + 13

Next i

.Buttons.Left = cLeft + (cMaxLetters * nWidth) +
24

CurrentSheet.Activate

With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) *
nHeight + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With

.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets
(cb.Caption).PrintOut
End If
Next cb
Else
MsgBox "No sheets selected"
End If
Application.DisplayAlerts = False

.Delete

End With

End Sub