Using Excel, I'd like to show the page number on the first sheet, where the start other sheets can be found.

Subscript out of range: It is not there.
The macro is looking for sheets named cover_ws, report_ws and Deviation_ws. You don't have sheets with these names.
You can try it without the double quotations or as below.
Check spelling, leading and trailing spaces in the sheet names.
Code:
shArr = Array("Cover Sheet", "BMS vs Azure DB", "Deviation Exceeded")
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
As promised. Go for a coffee and maybe lunch while this finishes.
Code:
Sub Get_Pages_With_HPageBreaks_Very_Slow()
Dim lr As Long, c As Range, x As Long
Dim shArr, i As Long, j As Long, a As String
a = ActiveSheet.Name
j = 20
shArr = Array("Cover Sheet", "BMS vs Azure DB", "Deviation Exceeded")
Application.ScreenUpdating = False
Application.EnableEvents = False

    For i = LBound(shArr) To UBound(shArr)
        Sheets(shArr(i)).Select
        x = 0
            With ActiveSheet
            lr = .Range("A" & .Rows.Count).End(xlUp).Row
                For Each c In .Range("A1:A" & lr)
                    If c.EntireRow.PageBreak <> -4142 Then x = x + 1
                Next c
            Sheets("BMS vs Azure DB").Cells(2, j).Value = x + 1    '<--- & " pages for " & shArr(i)
            j = j + 1
            End With
    Next i
   
Sheets(a).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Subscript out of range: It is not there.
The macro is looking for sheets named cover_ws, report_ws and Deviation_ws. You don't have sheets with these names.
You can try it without the double quotations or as below.
Check spelling, leading and trailing spaces in the sheet names.
Code:
shArr = Array("Cover Sheet", "BMS vs Azure DB", "Deviation Exceeded")
Yes, this needed the Array as the objects with not quotes. The code ran but came back with a 1 for each and still deletes the buttons. That one is so odd, it's some kinds of screen refreef issue as I can copy the cells that had the boutons to another sheet and the buttons are there. ???
shArr = Array(cover_ws, report_ws, Deviation_ws)
As promised. Go for a coffee and maybe lunch while this finishes.
Code:
Sub Get_Pages_With_HPageBreaks_Very_Slow()
Dim lr As Long, c As Range, x As Long
Dim shArr, i As Long, j As Long, a As String
a = ActiveSheet.Name
j = 20
shArr = Array("Cover Sheet", "BMS vs Azure DB", "Deviation Exceeded")
Application.ScreenUpdating = False
Application.EnableEvents = False

    For i = LBound(shArr) To UBound(shArr)
        Sheets(shArr(i)).Select
        x = 0
            With ActiveSheet
            lr = .Range("A" & .Rows.Count).End(xlUp).Row
                For Each c In .Range("A1:A" & lr)
                    If c.EntireRow.PageBreak <> -4142 Then x = x + 1
                Next c
            Sheets("BMS vs Azure DB").Cells(2, j).Value = x + 1    '<--- & " pages for " & shArr(i)
            j = j + 1
            End With
    Next i
  
Sheets(a).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
This code above is slow (timed it at 70 seconds) but seems to work the same as the other attempts.

It came back with:
Cover Sheet = 1 page
BMS vs Azure DB = 31 pages
Deviation Exceeded = 1 pages

I then do a print (the buttons come back(?)) and the PDF has:

Cover Sheet = 1 page
BMS vs Azure DB = 56 pages
Deviation Exceeded = 1 pages

I then run the script again and it now says:

Cover Sheet = 1 page
BMS vs Azure DB = 56 pages
Deviation Exceeded = 1 pages

So I still have to print before any option so far, can get the correct number of pages.

Lame but I could try printing twice in my script. :(

I wonder what is being updated during an actual print? Maybe there is a way to simulate it without doing a complete print.
 
Upvote 0
This script is faster but has the same issue.

VBA Code:
Sub Get_Pages_With_ExecuteExcel4Macro()
    Dim shArr As Variant
    Dim i As Long, j As Long
    Dim a As String

    a = ActiveSheet.Name
    j = 20
    shArr = Array("Cover Sheet", "BMS vs Azure DB", "Deviation Exceeded")

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    For i = LBound(shArr) To UBound(shArr)
        ' Select the sheet by name
        Sheets(shArr(i)).Select
        With ActiveSheet
            ' Use ExecuteExcel4Macro to get the accurate number of printed pages
            Sheets("BMS vs Azure DB").Cells(2, j).Value = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
            j = j + 1
        End With
    Next i

    ' Return to the original active sheet
    Sheets(a).Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Please don't quote. All extra junk we don't need.

You have something that we don't know about.
Use DropBox or a similar site to give us access to your workbook. Leave all the code you have in it and change personal info.
 
Upvote 0
Please don't quote. All extra junk we don't need.
Sorry, it helps me keep track and I think is a good way to keep folks in the loop of what it is I'm on about. :)

You have something that we don't know about.
Not sure what that would be and thanks for offering to look at it but I can not upload the files.

I just need some way to get the count of the printed pages. It seems there are a few ways to do this but they all need the PageSetup.Pages.Count property to be updated. I have a script now that works by using the PrintPreview property on each sheet but have not found a way to hide it from the user yet.

VBA Code:
    ' Activate each sheet before getting the page count
    cover_ws.Activate
    cover_ws.PrintPreview ' Force update of page layout
    cover_ws.Range("O2").Value = cover_ws.PageSetup.pages.Count

    report_ws.Activate
    report_ws.PrintPreview ' Force update of page layout
    cover_ws.Range("O3").Value = report_ws.PageSetup.pages.Count

    Deviation_ws.Activate
    Deviation_ws.PrintPreview ' Force update of page layout
    cover_ws.Range("O4").Value = Deviation_ws.PageSetup.pages.Count
 
Upvote 0
I found something from another post and have a script that now works but seems like a lot hoops to jump through.

Code for "Close Print Preview"

My working (thus far) code:
VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal uIDEvent As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal uIDEvent As Long) As Long
#End If

Sub PrintCoverAndMainSheet_new3()
    Dim FilePath As String
    Dim DefaultPath As String
    Dim FileName As String
    Dim CurrentDateTime As String
    Dim cover_ws As Worksheet
    Dim report_ws As Worksheet
    Dim Deviation_ws As Worksheet
    Dim OriginalActiveSheet As Worksheet
    Dim OriginalIndex As Long
    Dim OriginalSheet As Worksheet ' Declare OriginalSheet variable

    ' Set references to the source and destination sheets
    Set cover_ws = ThisWorkbook.Sheets("Cover Sheet")
    Set report_ws = ThisWorkbook.Sheets("BMS vs Azure DB")
    Set Deviation_ws = ThisWorkbook.Sheets("Deviation Exceeded")

    Call CopyRowsDeviationExceeded
    Call CopyRowsMissingPoints

    ' Set the original sheet to a variable and get its index
    Set OriginalActiveSheet = ActiveSheet
    Set OriginalSheet = ThisWorkbook.Sheets("Cover Sheet")
    OriginalIndex = OriginalSheet.Index

    ' Activate each sheet before getting the page count
    cover_ws.Activate
    ClosePrintPreview Close_In_HowMany_Seconds_FromNow:=0.1 ' Close preview after 0.1 seconds
    cover_ws.PrintPreview ' This will trigger the preview

    cover_ws.Range("O2").Value = cover_ws.PageSetup.pages.Count

    report_ws.Activate
    ClosePrintPreview Close_In_HowMany_Seconds_FromNow:=0.1 ' Close preview after 0.1 seconds
    report_ws.PrintPreview ' This will trigger the preview

    cover_ws.Range("O3").Value = report_ws.PageSetup.pages.Count

    Deviation_ws.Activate
    ClosePrintPreview Close_In_HowMany_Seconds_FromNow:=0.1 ' Close preview after 0.1 seconds
    Deviation_ws.PrintPreview ' This will trigger the preview

    cover_ws.Range("O4").Value = Deviation_ws.PageSetup.pages.Count
 
Upvote 0
Solution

Forum statistics

Threads
1,224,900
Messages
6,181,635
Members
453,059
Latest member
jkevin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top