![]() |
How can I get this code to work?
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 |
How can I get this code to work?
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 "Sam" wrote in message ... 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 |
All times are GMT +1. The time now is 01:17 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com