thanks sir dave,
the latest code always waits for me to click the *close* button of the print
preview page for *all* pages, maybe i need to choose from all codes u kindly
availed.
After more test, i feel to like the other one with a page header,
I guess u can modify one or two lines on the last part of the code something
like this...
= "Page &P of " & Format(TotalPages, "#,##0")
I like that the "{value A2} of " & Format(TotalPages, "#,##0")
I hope u can help me with this, i'm young for macro.....
Below is the cde for your kind finality.
--------------------------------------
Sub testme()
Dim wCtr As Long
Dim ArrNames() As String
Dim iCtr As Long
Dim myAddr As String
Dim wks As Worksheet
Dim mySelectedSheets As Sheets
Dim AddNameToArray As Boolean
Dim TotalPages As Long
Dim sh As Object
'get the total pages.
TotalPages = 0
For Each sh In Sheets
TotalPages = TotalPages + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next sh
myAddr = "A10
Set mySelectedSheets = ActiveWindow.SelectedSheets
ReDim ArrNames(1 To Worksheets.Count)
iCtr = 0
For wCtr = 1 To Worksheets.Count
AddNameToArray = False
With Worksheets(wCtr)
For Each wks In mySelectedSheets
If wks.Name = .Name Then
If IsNumeric(wks.Range(myAddr)) Then
If wks.Range(myAddr).Value = 0 Then
'in the grouped sheets, add it to the array
AddNameToArray = True
Exit For
End If
End If
End If
Next wks
If AddNameToArray = False Then
'look for that value
With .Range(myAddr)
If IsNumeric(.Value) Then
If .Value = 0 Then
'add it to the array
AddNameToArray = True
End If
End If
End With
End If
If AddNameToArray = True Then
iCtr = iCtr + 1
ArrNames(iCtr) = .Name
End If
End With
Next wCtr
If iCtr > 0 Then
'found at least one
'resize the array
ReDim Preserve ArrNames(1 To iCtr)
For wCtr = LBound(ArrNames) To UBound(ArrNames)
Worksheets(wCtr).PageSetup.CenterHeader _
= "Page &P of " & Format(TotalPages, "#,##0")
Next wCtr
Worksheets(ArrNames).PrintOut preview:=True
End If
End Sub
-------------------------------------------------
with sincere regards,
driller
--
*****
birds of the same feather flock together..
Dave Peterson said:
Ahh. I see what you mean...
Can you print each worksheet separately? Depending on your printer (and network
printer settings), you may get a page separator for each worksheet you print.
Option Explicit
Sub testme()
Dim wCtr As Long
Dim ArrNames() As String
Dim iCtr As Long
Dim myAddr As String
Dim wks As Worksheet
Dim mySelectedSheets As Sheets
Dim AddNameToArray As Boolean
Dim TotalPages As Long
Dim PagesPrintedBeforeThisSheet() As Long
Dim sh As Object
'get the total pages.
TotalPages = 0
ReDim PagesPrintedBeforeThisSheet(1 To Sheets.Count)
For wCtr = 1 To Sheets.Count
PagesPrintedBeforeThisSheet(wCtr) = TotalPages
TotalPages = TotalPages + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next wCtr
myAddr = "A10"
Set mySelectedSheets = ActiveWindow.SelectedSheets
ReDim ArrNames(1 To Worksheets.Count)
iCtr = 0
For wCtr = 1 To Worksheets.Count
AddNameToArray = False
With Worksheets(wCtr)
For Each sh In mySelectedSheets
If TypeName(sh) = "Worksheet" Then
If sh.Name = .Name Then
If IsNumeric(sh.Range(myAddr)) Then
If sh.Range(myAddr).Value = 0 Then
'in the grouped sheets, add it to the array
AddNameToArray = True
Exit For
End If
End If
End If
End If
Next sh
If AddNameToArray = False Then
'look for that value
With .Range(myAddr)
If IsNumeric(.Value) Then
If .Value = 0 Then
'add it to the array
AddNameToArray = True
End If
End If
End With
End If
If AddNameToArray = True Then
iCtr = iCtr + 1
ArrNames(iCtr) = .Name
End If
End With
Next wCtr
If iCtr > 0 Then
'found at least one
'resize the array
ReDim Preserve ArrNames(1 To iCtr)
For wCtr = LBound(ArrNames) To UBound(ArrNames)
Sheets(wCtr).PageSetup.FirstPageNumber _
= PagesPrintedBeforeThisSheet(Sheets(ArrNames(wCtr)).Index) + 1
Sheets(wCtr).PageSetup.CenterHeader _
= "Page &P of " & Format(TotalPages, "#,##0")
Sheets(wCtr).PrintOut preview:=True
Next wCtr
End If
End Sub
thanks Sir Dave,
I found the auto-header embedded yet the page number per page do not JUMP
when the unselected sheets are eliminated in the group...is it possible to
maintain the page number per page assuming that nothing had been unselected
in the group....
if this is not possible...please inform me so i will quit asking for a maybe
*impossible*.. I can hardcode the &[pages] before printing but the &[page] is
my problem...
Also, one thing, I tested testme() for a group of 62 sheets and the header
only appears from page 1 to 56 of 62, the next page headers 57 to 60 of 62 do
not appear in the print preview...dont know why?
thanks and regards,
driller
--
*****
birds of the same feather flock together..
:
First, the code looped through all the pages to get the totalpages count. Then
it put it in the header for you. You'll have to change that portion of the code
if you don't like it in the .centerheader.
Untested--I just added more checks:
Option Explicit
Sub testme()
Dim wCtr As Long
Dim ArrNames() As String
Dim iCtr As Long
Dim myAddr As String
Dim wks As Worksheet
Dim mySelectedSheets As Sheets
Dim AddNameToArray As Boolean
Dim TotalPages As Long
Dim sh As Object
'get the total pages.
TotalPages = 0
For Each sh In Sheets
TotalPages = TotalPages + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next sh
myAddr = "A10"
Set mySelectedSheets = ActiveWindow.SelectedSheets
ReDim ArrNames(1 To Worksheets.Count)
iCtr = 0
For wCtr = 1 To Worksheets.Count
AddNameToArray = False
With Worksheets(wCtr)
For Each wks In mySelectedSheets
If wks.Name = .Name Then
If IsNumeric(wks.Range(myAddr)) Then
If wks.Range(myAddr).Value = 0 Then
'in the grouped sheets, add it to the array
AddNameToArray = True
Exit For
End If
End If
End If
Next wks
If AddNameToArray = False Then
'look for that value
With .Range(myAddr)
If IsNumeric(.Value) Then
If .Value = 0 Then
'add it to the array
AddNameToArray = True
End If
End If
End With
End If
If AddNameToArray = True Then
iCtr = iCtr + 1
ArrNames(iCtr) = .Name
End If
End With
Next wCtr
If iCtr > 0 Then
'found at least one
'resize the array
ReDim Preserve ArrNames(1 To iCtr)
For wCtr = LBound(ArrNames) To UBound(ArrNames)
Worksheets(wCtr).PageSetup.CenterHeader _
= "Page &P of " & Format(TotalPages, "#,##0")
Next wCtr
Worksheets(ArrNames).PrintOut preview:=True
End If
End Sub
driller wrote:
Almost!!! You really help!!!
thanks Sir Dave
maybe one last try, the macro indeed select the sheets Except the first
selected sheet in the group where A10<>0,
the rest of the macro-selected sheets passed to the criteria of A10=0...
What shall i do with the code so it will also remove the first sheet *in the
group* when A10<>0? One more try and i can *possibly* do the
multiselected-page printing without hesitation...
No problem with the &[Page] of &[Pages] to hardcode it in the page
footer...maybe theres no macro to do the specific...
i will just reserve a formulated cell to replace the footer function, and
include this cell in the print page...
thanks and regards,
driller
--
*****
birds of the same feather flock together..
:
I think you'll have to find out the total number of sheets that would be printed
if you printed the whole workbook--then change the footer. Just hardcode that
page number into the footer.
And since one worksheet always has to be selected, does that mean that if only
one sheet is selected (or grouped), then that sheet should be included in the
pages to be printed? I'm gonna guess yes.
Option Explicit
Sub testme()
Dim wCtr As Long
Dim ArrNames() As String
Dim iCtr As Long
Dim myAddr As String
Dim wks As Worksheet
Dim mySelectedSheets As Sheets
Dim AddNameToArray As Boolean
Dim TotalPages As Long
Dim sh As Object
'get the total pages, sheet by sheet
TotalPages = 0
For Each sh In Sheets
TotalPages = TotalPages + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next sh
myAddr = "A10"
Set mySelectedSheets = ActiveWindow.SelectedSheets
ReDim ArrNames(1 To Worksheets.Count)
iCtr = 0
For wCtr = 1 To Worksheets.Count
AddNameToArray = False
With Worksheets(wCtr)
For Each wks In mySelectedSheets
If wks.Name = .Name Then
'in the grouped sheets, add it to the array
AddNameToArray = True
Exit For
End If
Next wks
If AddNameToArray = False Then
'look for that value
With .Range(myAddr)
If IsNumeric(.Value) Then
If .Value = 0 Then
'add it to the array
AddNameToArray = True
End If
End If
End With
End If
If AddNameToArray = True Then
iCtr = iCtr + 1
ArrNames(iCtr) = .Name
End If
End With
Next wCtr
If iCtr > 0 Then
'found at least one
'resize the array
ReDim Preserve ArrNames(1 To iCtr)
For wCtr = LBound(ArrNames) To UBound(ArrNames)
Worksheets(wCtr).PageSetup.CenterHeader _
= "Page &P of " & Format(TotalPages, "#,##0")
Next wCtr
Worksheets(ArrNames).PrintOut preview:=True
End If
End Sub
driller wrote:
Hi Dave,
Here is a sample scenario of what i we are up to...
sheetname *VALUE of A10*
MASTER
sheet1-1 10
sheet1-2 0
sheet1-3 11
sheet1-4 0
