PageSetup.PrintArea doesn't work as intended

Question

I am trying to print out section, that is marked as Printarea. This code however sometimes runs good and sometimes it doesn't. There is really no rule with it. The question is, how can I make it 100% runnable. What it does when it runs good. It prints the area, saves it as Picture and then quits. What it does when it doesn't. It prints blank white page without any data on it, as if printing blank page. The fact that the page prints, evethough its blank suggests that the saving is not a problem. Can you help?

OK, I will reveal my cards. This started as "learning this area of VBA" project (printing saving pictures), so I tried to pull data from website about my arrival to work and then printing what day it is, how far are we with the week so far etc. The whole code is revealed since the fixed range helped a bit, but I still get blank pages in 10% of cases when ran manually and 50% of cases when ran after win start via vbs script. basically I noticed that stressed CPU is in direct correlation to succesful code run. All files are local except for the website pull which is always succesful.

VBS:

Set objExcel = CreateObject("Excel.Application")
objExcel.Application.Run "'*someCorporatePath\newStart.xlsb'!Module1.Auto_Open"
objExcel.DisplayAlerts = False
objExcel.Application.Quit
Set objExcel = Nothing

Module 1

    Option Explicit

    Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
                            (ByVal uAction As Long, ByVal uParam As Long, _
                             ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

    Public Const SPI_SETDESKWALLPAPER = 20
    Public Const SPIF_SENDWININICHANGE = &H2
    Public Const SPIF_UPDATEINIFILE = &H1
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

    Sub Auto_Open()
        Call getDataFromWebsite
        Call weekProgress
        Call saveSheet
        Call changeWallpaper
        Application.DisplayAlerts = False
        Application.Quit
    End Sub

    Sub getDataFromWebsite()
    Dim x As String
    Dim IE As Object
    Dim HtmlCon As HTMLDocument
    Dim element As Object
    Dim ArrivalTime

        On Error GoTo Handler
        x = "*Some-secret-corporate-website*"
        Set IE = New InternetExplorerMedium
        IE.Navigate (x)
        IE.Visible = False
        Do While IE.ReadyState <> 4
            DoEvents
        Loop
        Set HtmlCon = IE.document
        Set element = HtmlCon.getElementsByClassName("*someAJAXcorporateElement*")
        ArrivalTime = element(0).innerText
        ThisWorkbook.Sheets(1).Cells(3, 15).Value = ArrivalTime
    Handler:
        IE.Quit
    End Sub

Sub weekProgress()
Dim caseResult As String
Dim offsetDayIndex As Integer
Const dayBarLenght = 2

    Select Case Application.WorksheetFunction.Weekday(Date, 2)
        Case 1
            caseResult = "Monday"
            offsetDayIndex = 0
        Case 2
            caseResult = "Tuesday"
            offsetDayIndex = 1
        Case 3
            caseResult = "Wednesday"
            offsetDayIndex = 2
        Case 4
            caseResult = "Thursday"
            offsetDayIndex = 3
        Case 5
            caseResult = "Friday"
            offsetDayIndex = 4
        Case Else
            caseResult = "Monday"
    End Select
DoEvents
ThisWorkbook.Sheets(1).Cells(24, 11).Value = caseResult
ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(31, 5), ThisWorkbook.Sheets(1).Cells(31, 12)).Interior.ColorIndex = 1
If Not caseResult = "Monday" Then
    ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).Cells(31, 5), ThisWorkbook.Sheets(1).Cells(31, 4 + (dayBarLenght * offsetDayIndex))).Interior.ColorIndex = 2
End If

End Sub

Sub saveSheet()
Dim oCht As Object
Dim zoom_coef
Dim area
Dim intLastRow As Integer
Dim intLastCol As Integer

zoom_coef = 100 / ThisWorkbook.Sheets(1).Parent.Windows(1).Zoom


With ThisWorkbook.Sheets(1)
        .PageSetup.PrintArea = .Range("A1", .Cells(37, 17)).Address
End With


Set area = ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).PageSetup.PrintArea)

DoEvents
area.CopyPicture xlPrinter
    Application.DisplayAlerts = False
    Set oCht = ThisWorkbook.Sheets(1).ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    oCht.Chart.Paste
    oCht.Chart.Export Filename:="*MyCorporatePath*", Filtername:="bmp"
    oCht.Delete
    Application.DisplayAlerts = True

End Sub

Sub changeWallpaper()
Dim strImagePath As String

    strImagePath = "*MyCorporatePath*"
    Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, strImagePath, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)

End Sub

Answer 1

Requirement: To save the PrintArea of the first worksheet as a bmp file.

Original procedure:

Sub saveSheet()
Dim oCht As Object
Dim zoom_coef
Dim area

zoom_coef = 100 / ThisWorkbook.Sheets(1).Parent.Windows(1).Zoom
Set area = ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).PageSetup.PrintArea)
area.CopyPicture xlPrinter

    Application.DisplayAlerts = False
    Set oCht = ThisWorkbook.Sheets(1).ChartObjects.Add(0, 0, area.Width * zoom_coef, area.Height * zoom_coef)
    oCht.Chart.Paste
    oCht.Chart.Export Filename:="C:\Users\insertyourname\Pictures\savedImage.bmp", Filtername:="bmp"
    oCht.Delete
    Application.DisplayAlerts = True

End Sub

The procedure as originally stated in the post creates a range named area using the PageSetup.PrintArea property as the reference for the range.

If the PrintAreais set to the entire sheet then the PrintArea property would be equal to an empty string and the instruction below will generate an error.

Set area = ThisWorkbook.Sheets(1).Range(ThisWorkbook.Sheets(1).PageSetup.PrintArea)

As the procedure is printing a blank page, we can assume that the PrintArea property is a valid A1-style reference.

The printing of a blank page when the PageSetup.PrintArea property is a valid A1-style reference could be replicated at least in the following cases:
1. When the range corresponding to the PrintArea is in fact a range of empty cells,
2. When the range corresponding to the PrintArea has its rows or columns hidden,
3. When printing a chart and although the rows and columns of the chart are visible the rows or columns of the Chart.SourceData are hidden, thus the chart is blank.

The original procedure has been adjusted in order to ask the user to validate the output and if the output is blank them it presents the user with the printed range (i.e. the Print.Area) so the necessary corrections can be applied.

Sub Save_PrintArea_As_bmp()
Dim ws As Worksheet
Dim oCht As Object
Dim ddZoomCoef As Double
Dim rArea As Range

    Set ws = ThisWorkbook.Worksheets(1)     'Modify as required
    With ws
        ddZoomCoef = 100 / .Parent.Windows(1).Zoom
        Set rArea = .Range(.PageSetup.PrintArea)
        rArea.CopyPicture xlPrinter
        Set oCht = .ChartObjects.Add(0, 0, _
            rArea.Width * ddZoomCoef, rArea.Height * ddZoomCoef)
    End With

    Application.DisplayAlerts = False
    With oCht

        .Chart.Paste
        If MsgBox("Is the printed page blank?", _
            vbQuestion + vbYesNo + vbDefaultButton2, _
            "Save PrintArea As bmp") = vbYes Then

            .Delete

            MsgBox "This is the PrintArea, validate that the range is visible."
            With ws
                .Activate
                Application.Goto .Cells(1), 1
                Application.Goto rArea
                Exit Sub
                Application.DisplayAlerts = True
            End With

        Else

        .Chart.Export Filename:="D:\@D_Trash\savedImage.bmp", _
            Filtername:="bmp"     'Modify as required
        .Delete

    End If: End With
    Application.DisplayAlerts = True

    End Sub

Answer 2

It sounds like you want to save an image of the area that would be printed, even if the user has not specified a print area. The problem is that Excel has no .PrintArea value if one has not been specified by a user. See below for further details.

To ensure the code works as intended, you can either stop the code early if no print area has been set:

If ThisWorkbook.Sheets(1).PageSetup.PrintArea = vbNullString Then
    MsgBox "No print area has been set.", vbCritical, "Save Sheet"
    Exit Sub
End If

Or you can set the print area manually to include all values by placing this at the start of the macro:

Dim intLastRow as Integer
Dim intLastCol As Integer

With ThisWorkbook.Sheets(1)

    If .PageSetup.PrintArea = vbNullString Then

        intLastRow = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
                 LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                 MatchCase:=False).Row

        intLastCol = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, _
                 LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                 MatchCase:=False).Column

        .PageSetup.PrintArea = .Range("A1", .Cells(intLastRow, intLastCol)).Address

    End If

End With

Note that this closely mimics the default print area to start from A1, but does not include more distant cells that include only formatting or objects. This is likely sufficient for your needs, but it could be adjusted further if you didn't want it to start from A1 or if you need to include cells that contain only formatting or objects.

Notes on "Default Print Area"

There isn't strictly a default print area determined by Excel at the time of printing. It instead prints as many continuous pages as necessary to include all cells that contain any values, formatting or objects, starting from A1 (regardless of where content starts). This is not necessarily a rectangular area and the number of pages printed can depend on the print order. It also does not necessarily include all cells in the .UsedArea

For example, enter a value in W15 (3 pages to the right) and E70 (1 page down). If printing without setting a print area, Excel will start with a blank page from A1. The default print order setting of down-then-across will result in 5 pages being printed from the layout below: Pages 1,4,2,5,3. Changing to print across-then-down will result in only 4 pages being printed: Pages 1,2,3,4. Manually setting the print area instead results in all 6 pages being printed in whichever order is specified.