ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Macro to select which worksheet to print (https://www.excelbanter.com/excel-programming/385672-macro-select-worksheet-print.html)

Angel_24477616
Macro to select which worksheet to print
 
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)


Dim Kount As Integer


For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next


End Function


Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer


StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select



End Sub


Regards,
Angel

Tom Ogilvy
Macro to select which worksheet to print
 
You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy


"Angel_24477616" wrote:

The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)


Dim Kount As Integer


For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next


End Function


Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer


StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select



End Sub


Regards,
Angel

okrob
Macro to select which worksheet to print
 
On Mar 20, 7:50 am, "Angel_24477616"
wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel

..Select is not necessary in the function.
User input can be how you want it, but I chose to have them pick the
label based on the sheet name.
This macro ran on my machine in a little under a second. I can't
imagine needing it to be faster.
Perhaps you have more code that calculates the L1-L20 sheets first?
Anyway, what follows worked for me.


Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As _

Integer)
Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
Dim Lx As String
Lx = InputBox("Which Label? L1, L2, etc...")
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Sheets(Lx).Select
Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Range("B2").Select
End Sub

okrob
Macro to select which worksheet to print
 
On Mar 20, 8:25 am, Tom Ogilvy
wrote:
You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy



"Angel_24477616" wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel- Hide quoted text -

- Show quoted text -

Here it is with Tom's Suggestion... They get to use a checkbox
instead of typing to select the label to print.


Option Explicit
Function RepeatPagePrint(StartPage As Integer, _
EndPage As Integer, PageTotal As Integer)

Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
MsgBox "here"
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
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

' 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.Select
' 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

okrob
Macro to select which worksheet to print
 
On Mar 20, 8:39 am, "okrob" wrote:
On Mar 20, 8:25 am, Tom Ogilvy
wrote:





You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy

"Angel_24477616" wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel- Hide quoted text -

- Show quoted text -

Here it is with Tom's Suggestion... They get to use a checkbox
instead of typing to select the label to print.

Option Explicit
Function RepeatPagePrint(StartPage As Integer, _
EndPage As Integer, PageTotal As Integer)

Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
MsgBox "here"
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
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

' 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.Select
' 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- Hide quoted text -

- Show quoted text -

The only problem would be if they selected more than one label at a
time. You could look at the SelectSheets sub and may be able to
modify it to only allow one page selected at a time.

okrob
Macro to select which worksheet to print
 
On Mar 20, 8:39 am, "okrob" wrote:
On Mar 20, 8:25 am, Tom Ogilvy
wrote:





You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy

"Angel_24477616" wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel- Hide quoted text -

- Show quoted text -

Here it is with Tom's Suggestion... They get to use a checkbox
instead of typing to select the label to print.

Option Explicit
Function RepeatPagePrint(StartPage As Integer, _
EndPage As Integer, PageTotal As Integer)

Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
MsgBox "here"
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
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

' 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.Select
' 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- Hide quoted text -

- Show quoted text -

Here it is with Option Buttons instead. That way, the user can only
select one label...

Option Explicit
Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As _

Integer)
Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False

' 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.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(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.OptionButtons
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.Select
' 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

Angel_24477616
Macro to select which worksheet to print
 
On 20 Mar, 13:50, "okrob" wrote:
On Mar 20, 8:39 am, "okrob" wrote:





On Mar 20, 8:25 am, Tom Ogilvy
wrote:

You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy

"Angel_24477616" wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel- Hide quoted text -

- Show quoted text -

Here it is with Tom's Suggestion... They get to use a checkbox
instead of typing to select the label to print.

Option Explicit
Function RepeatPagePrint(StartPage As Integer, _
EndPage As Integer, PageTotal As Integer)

Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
MsgBox "here"
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
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

' 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.Select
' 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- Hide quoted text -

- Show quoted text -

Here it is with Option Buttons instead. That way, the user can only
select one label...

Option Explicit
Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As _

Integer)
Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False

' 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.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(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.OptionButtons
If cb.Value = xlOn Then
Worksheets(cb.Caption).Activate
ActiveSheet.Select
' 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
'
...

read more »- Hide quoted text -

- Show quoted text -

Rob & Tim, I would like to thank you so much for your help. I have
opted for the solution using options buttons as this suits me
perfectly.
Many, many thanks,
Angel

Tom Ogilvy
Macro to select which worksheet to print
 
You welcome Angle <g

--
Regards,
Tom Ogilvy

"Angel_24477616" wrote:

On 20 Mar, 13:50, "okrob" wrote:
On Mar 20, 8:39 am, "okrob" wrote:





On Mar 20, 8:25 am, Tom Ogilvy
wrote:

You can integrate this code with your code:

http://www.j-walk.com/ss/excel/tips/tip48.htm

--
Regards,
Tom Ogilvy

"Angel_24477616" wrote:
The code below is designed to print pallet labels. I have a sheet
where data is entered which is formulated to worksheets named L1 to
L20. I could create 20 different forms with macros attached that have
variations from the one shown below depending on which label I would
like to print. It would be great if I could have one macro that would
select the correct sheet to print based on an input for example. Can
anybody help me?

Also if anybody could refine this code so that the macro runs faster,
that would be much appreciated.

Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As Integer)

Dim Kount As Integer

For Kount = StartPage To EndPage
Sheets("L1").Select
Range("A1:I44").Select
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next

End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer

StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage

Call RepeatPagePrint(StPage, EnPage, PgTotal)
Sheets("Data").Select
Range("b2").Select

End Sub

Regards,
Angel- Hide quoted text -

- Show quoted text -

Here it is with Tom's Suggestion... They get to use a checkbox
instead of typing to select the label to print.

Option Explicit
Function RepeatPagePrint(StartPage As Integer, _
EndPage As Integer, PageTotal As Integer)

Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
MsgBox "here"
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
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

' 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.Select
' 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- Hide quoted text -

- Show quoted text -

Here it is with Option Buttons instead. That way, the user can only
select one label...

Option Explicit
Function RepeatPagePrint(StartPage As Integer, EndPage As Integer,
PageTotal As _

Integer)
Dim Kount As Integer
For Kount = StartPage To EndPage
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$44"
With ActiveSheet.PageSetup
.LeftFooter = "&""Arial,Bold""&48 " & " " & Kount
.CenterFooter = "&""Arial,Bold""&36OF"
.RightFooter = "&""Arial,Bold""&48 " & PageTotal & " "
.CenterHorizontally = False
.CenterVertically = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 99
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True
Next
End Function

Sub DoRepeatPrint()
Dim StPage As Integer
Dim EnPage As Integer
Dim PgTotal As Integer
StPage = 1
EnPage = Val(InputBox("How many Pallets"))
'EnPage = Sheets("Data").Range("K2")
'PgTotal = Sheets("Data").Range("K2")
PgTotal = EnPage
Call SelectSheets
Call RepeatPagePrint(StPage, EnPage, PgTotal)
'Sheets("Data").Range("B2").Select
End Sub

Sub SelectSheets()
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton
Application.ScreenUpdating = False

' 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.OptionButtons.Add 78, TopPos, 150, 16.5
PrintDlg.OptionButtons(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


All times are GMT +1. The time now is 05:38 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com