Printing Embedded web browser

[luvbite38]

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
I am having a weird problem with printing my summary page in a workbook. My summary page contains a combination of charts, text and embedded internet explorer (showing Google Map). It all works fine when you look at it on the screen, everything is fully functional. However, when I am printing this page, it prints everything except the embedded Google Map. It has been two days since I am trying to fix this issue L. But no luck. Print object is true and checked for the web browser. Could you guys please help me fix this issue so I can print the entire page including the currently displayed screen of the explorer.<o></o>
<o> </o>
Is it possible that to write a code to take a screenshot of the entire page (including the web browser) and overlay on top of my existing page and if someone cancels the print option or when the page is gone to printer. It automatically deletes the screenshot and it gets back to original settings i.e. my summary page??<o></o>
<o> </o>
Hope it makes sense??<o></o>
<o> </o>
Please help…<o></o>
<o> </o>

 

[Lohan912]

Hi Jaafar

I have tried this with a project I am running and it works, thanks! But when i print the "Microsoft Web Browser" control it comes out extremely small, would you happen to know how I can do to make the window bigger?

Also, I would actually like to save an Excel sheet as a.pdf with the "Microsoft Web Browser" displaying content on the document - could you please explain the approach you are taking in achieving the window to be printable?

Thanking you in advance!

Kind regards,

Lohan

 

[Jaafar Tribak]

Hi Jaafar

I have tried this with a project I am running and it works, thanks! But when i print the "Microsoft Web Browser" control it comes out extremely small, would you happen to know how I can do to make the window bigger?

Also, I would actually like to save an Excel sheet as a.pdf with the "Microsoft Web Browser" displaying content on the document - could you please explain the approach you are taking in achieving the window to be printable?

Thanking you in advance!

Kind regards,

Lohan

Hi lohan,

I don't have a printer installed at the moment to test this.... I'll let you know if anything comes up

 

[bobgentry]

I'm totally going to necro this thread, since I've solved it.
(in fact that's why i finally registered after lurking for some time)

Background:
I too came up with a worksheet with an embedded browser object that I needed to print along with other information (generated and stored on the sheet, via macros). And I too came up against the problem of printing the sheet with the browser control visible.

Googling revealed only a handful of similar people with similar questions, all which either never found a solution, or they pointed here, to this thread.
(hence the necro'ing to share the solution)

The first set of code didn't work terribly well, as in the time since MS seems to have deprecated this common dialog method thing, and I don't have the permissions at work to simply download and install the missing DLL.

So onto the second set of code: It works. But as the poster a couple of posts above points out, it prints really small. Now, while I am decently versed in VBA and Excel, and have recently started learning to use some external functions like FindWindowEx to get excel to talk to other instances of excel not visible to the launching Application object (another long story....), I know nothing about the DCs and the GDI set of functions.

Or at least I didn't a week ago. Now I know a little, enough to be dangerous, and so I've fixed the code so it prints to the printer full page.
This may have been old hat for folks long used to GDI (found excel code examples going back to 1998!), but as I said, I'm learning as I go.

And so here is the corrected code for the module with the function "PrintVisibleRange":

Option Explicit

Private Type DOCINFO
    cbSize As Long
    lpszName As String
    lpszOutput As Long
End Type


'Find Window functions
Private Declare Function FindWindow Lib "user32.dll" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "User32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

'Device Context (DC) related functions
Private Declare Function CreateDC Lib "gdi32" _
Alias "CreateDCA" _
(ByVal lpDriverName As String, _
ByVal lpDeviceName As String, _
ByVal lpOutput As String, _
ByVal lpInitData As Any) As Long
 
Private Declare Function GetDC Lib "User32" _
(ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "User32" ( _
ByVal hwnd As Long, _
ByVal hDc As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hDc As Long, ByVal nIndex As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hDc As Long) As Long

Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hDc As Long) As Long
 
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
(ByVal hDc As Long, _
ByVal bmp_Width As Long, _
ByVal bmp_Height As Long) As Long
 
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDc As Long, _
ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Private Declare Function BitBlt Lib "gdi32" _
(ByVal hDestDC As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal destWidth As Long, _
ByVal destHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long

Private Declare Function StretchBlt Lib "gdi32" _
(ByVal hdcDest As Long, _
ByVal xDest As Long, _
ByVal yDest As Long, _
ByVal destWidth As Long, _
ByVal destHeight As Long, _
ByVal hdcSrc As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal srcWidth As Long, _
ByVal srcHeight As Long, _
ByVal dwRop As Long) As Long
 
'Printer DC related functions
Private Declare Function StartDoc Lib "gdi32" _
Alias "StartDocA" (ByVal hcs As Long, lpDI As DOCINFO) As Long

Private Declare Function EndDoc Lib "gdi32" (ByVal hcs As Long) As Long

Private Declare Function GetDefaultPrinter Lib "winspool.drv" _
Alias "GetDefaultPrinterA" _
(ByVal sPrinterName As String, _
lPrinterNameBufferSize As Long) As Long


'**GetDeviceCaps Constants
'**List of Devicecaps Constants can be found at:
'**http://pinvoke.net/default.aspx/gdi32/GetDeviceCaps.html
Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90

'Other constants
Private Const PointsPerInch = 72
Private Const SRCCOPY As Long = &HCC0020

'**Clipboard functions used in debugging.
'**Can be removed.
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long

'**Constant for clipboard functions used in debugging
'**Can be removed.
Private Const CF_BITMAP = 2


'---------------'
'Public routine.'
'---------------'
Public Sub PrintVisibleRange()

    'Define classes
    Dim cScreen As c_bmp
    Dim cPrint As c_bmp
    Set cScreen = New c_bmp
    Set cPrint = New c_bmp
    
    'Excel Window variables
    Dim hwnd As Long
    Dim lwbDC As Long
    Dim bHeadings As Boolean
    
    'Printer variables
    Dim MyDoc As DOCINFO
    Dim printerDC As Long
    
    'Store the workbook hwnd.
    hwnd = FindWindow("XLMAIN", Application.Caption)
    hwnd = FindWindowEx(Application.hwnd, 0&, "XLDESK", vbNullString)
    hwnd = FindWindowEx(hwnd, 0&, "EXCEL7", vbNullString)
    
    'store the row & column headers visible state.
    bHeadings = Application.ActiveWindow.DisplayHeadings
    
    'hide the row & column headers.
    If bHeadings Then Application.ActiveWindow.DisplayHeadings = False
    
    'Store the workbook window dc.
    lwbDC = GetDC(hwnd)
    'retrieve the default printer dc.
    printerDC = GetPrinterDC
    
    'Get the Visible Range and Printer height & widths.
    cScreen.width = Application.ActiveWindow.VisibleRange.width
    cScreen.height = Application.ActiveWindow.VisibleRange.height
    cPrint.width = GetDeviceCaps(printerDC, HORZRES)
    cPrint.height = GetDeviceCaps(printerDC, VERTRES)
    
    'Convert screen height and widths
    '**(don't need to convert the printer H/W because we determined them directly above)
    cScreen.width = cScreen.width * GetDeviceCaps(GetDC(0), LOGPIXELSX) / PointsPerInch
    cScreen.height = cScreen.height * GetDeviceCaps(GetDC(0), LOGPIXELSY) / PointsPerInch
    
    'create memory DC's.
    cScreen.memoryDC = CreateCompatibleDC(lwbDC)
    cPrint.memoryDC = CreateCompatibleDC(printerDC)
    
    'detect if failed to create memory DC
    If cScreen.memoryDC = 0 Then
        MsgBox "Error in creating Screen Memory DC"
        GoTo cleanup
    ElseIf cPrint.memoryDC = 0 Then
        MsgBox "Error in creating Print Memory DC"
        GoTo cleanup
    End If
    
    'create compatible bmp's.
    cScreen.bmp = CreateCompatibleBitmap(lwbDC, cScreen.width, cScreen.height)
    cPrint.bmp = CreateCompatibleBitmap(printerDC, cPrint.width, cPrint.height)
    
    'detect if failed to create a bmp
    If cScreen.bmp = 0 Then
        MsgBox "Error in creating Screen BMP"
        GoTo cleanup
    ElseIf cPrint.bmp = 0 Then
        MsgBox "Error in creating Print BMP"
        GoTo cleanup
    End If
    
    'select the bmp to the memory dc.
    DeleteObject SelectObject(cScreen.memoryDC, cScreen.bmp)
    DeleteObject SelectObject(cPrint.memoryDC, cPrint.bmp)
    
    'copy the visible range onto the screen memory dc.
    BitBlt cScreen.memoryDC, 0, 0, cScreen.width, cScreen.height, lwbDC, 0, 0, SRCCOPY
    
    'stretch copy the screen memory dc into the printer memory dc
    StretchBlt cPrint.memoryDC, 0, 0, cPrint.width, cPrint.height, cScreen.memoryDC, 0, 0, cScreen.width, cScreen.height, SRCCOPY
    
    'restore the row & column headers.
    Application.ActiveWindow.DisplayHeadings = bHeadings
    
    '**Clipboard for debugging, so can paste into MSPaint.
    '**
    '**(can use cPrint.bmp also, but that results in a black image in MSPaint,
    '**probably due to being a bmp created to be compatible with the print,
    '**not the screen, though I could be wrong, am not an expert in this area)
    '**
    '**Can be removed.
    OpenClipboard hwnd
    EmptyClipboard
    SetClipboardData CF_BITMAP, cScreen.bmp
    CloseClipboard
    
    '**For debugging to skip the actual print.
    '**Can be removed.
    'printerDC = 0
    
    If printerDC <> 0 Then
    
        'Initialize the DOCINFO srtucture.
        MyDoc.lpszName = "VisibleRange_PrintOut"
        MyDoc.lpszOutput = 0
        MyDoc.cbSize = Len(MyDoc)

        'Start a new print job.
        Call StartDoc(printerDC, MyDoc)
        
        'Print the bitmap stored in the printer memory dc
        BitBlt printerDC, 0, 0, cPrint.width, cPrint.height, cPrint.memoryDC, 0, 0, SRCCOPY
        
        'End the printing.
        Call EndDoc(printerDC)
    End If
     
    'CleanUp.
cleanup:
    Call DeleteDC(printerDC)
    Call ReleaseDC(0, lwbDC)
    Call DeleteDC(cScreen.memoryDC)
    Call DeleteDC(cPrint.memoryDC)

End Sub


'------------------'
'Private routines .'
'------------------'

Private Function GetPrinterDC() As Long

    Dim sBuffer As String
    Dim sPrinterName As String
    Dim hPrinter As Long
    
    sBuffer = Space(128)
    If GetDefaultPrinter(sBuffer, 128) Then
        sPrinterName = Left(sBuffer, 128 - 1)
        GetPrinterDC = CreateDC("WINSPOOL", sPrinterName, vbNullString, 0&)
    End If

End Function

I cleaned it up some, took out the seperate PTtoPX and DPI functions. But the main fix is in creating a 2nd memoryDC/bmp pair, specific to and compatible with the printerDC. The screen memorydc/bmp is then StretchBlt'ed into the printer memoryDC/bmp, and then THAT (the printer one) is Bitblt'ed to the printer. I think I've thoroughly commented it. Also left in some debugging code I used to put the bmp's into the clipboard so I could paste into MSPaint and see what was being grabbed, though I discovered that the printer memoryDC/bmp thing only pastes a black image from clipboard, even when it prints correctly to the printer, probably because it was created to be compatible with the printer, not necessarily MSPaint and the screen.

Oh, and also created a class object, because the data structure for the screen and printer variable sets were identical, so that also helped clean up and simplify the code. So you'll also need this for the class 'c_bmp' :

Option Explicit

Private p_width As Single
Private p_height As Single
Private p_memoryDC As Long
Private p_bmp As Long


Public Property Get bmp() As Long
    bmp = p_bmp
End Property
Public Property Get memoryDC() As Long
    memoryDC = p_memoryDC
End Property
Public Property Get width() As Single
    width = p_width
End Property
Public Property Get height() As Single
    height = p_height
End Property

Public Property Let bmp(l_bmp As Long)
    p_bmp = l_bmp
End Property
Public Property Let memoryDC(l_memoryDC As Long)
    p_memoryDC = l_memoryDC
End Property
Public Property Let width(l_width As Single)
    p_width = l_width
End Property
Public Property Let height(l_height As Single)
    p_height = l_height
End Property

From here I can see how I would modify it to be smaller than the entire VisibleRange (still needs to be on screen to be grabbed, i think - haven't tested yet, but for my use that's not a problem), and a few other things for my specific situation, but that's not important here.

The chief problem left hanging, the printout being tiny, is now fixed* and The Knowledge added to.
Yay!



*only issue i've encountered is sometimes the printer compatible bitmap and/or DC will fail (hence the error checks to detect it). I believe, but can't prove yet (since I barely know what I'm doing here), that that was a result of my rather limited work computer running out of memory as I ran the code a few million times before i remembered to release the printerDC's. it hasnt since repeated that problem for me, knock on wood.

 

[bobgentry]

oh, also learned that there is the issue, or rather the apparently common 'best practice' of not using Bitblt and Stretchblt to talk to printers, because some/most printer drivers dont support those operations, and are considered 'device specific bitmaps' or something. so the preferred practice is to use 'device independent bitmaps' or DIBs. i have yet to fully learn this, or how to convert (found a lot of C++ code though) to them.

but for now, that seems to be a moot point on that basis that, if you get the image printed at all (tiny from the original code, or now large from mine), then your printer supports the bitblt and stretchblt operations (and both my hoime and work pritners apparently do). :P so yay!

but there should be a way to query the printer using GetDeviceCaps and the RASTERCAPS index (GetDeviceCaps(printerDC, RASTERCAPS)), but the value returned was really big, and how that translates into the various subheadings under RASTERCAPS (https://msdn.microsoft.com/en-us/library/windows/desktop/dd144877(v=vs.85).aspx), I dont know.

Yet.

 

[vanillacoke1]

Hey bobgentry, thanks for working on this code. I am a newbie and not sure where the second part of your code (the class object) should go. I tried pasting it underneath the first part of code but I'm still getting an error on the c_bmp line. Could you tell me where exactly that code should go or share a sample excel file with your code? Thanks!

 

[lkmason23]

You are welcome and glad it worked for you.

Hi, great work. I don't suppose this could be tweaked to capture just the contents of a web browser control could it?

Trying to effectively save a PDF of the web browser only.

Thanks

 

[Jaafar Tribak]

Hi, great work. I don't suppose this could be tweaked to capture just the contents of a web browser control could it?

Trying to effectively save a PDF of the web browser only.

Thanks

Is the webbrowser embdded on a a worksheet or on a userform ?

 

[Jaafar Tribak]

Hi, great work. I don't suppose this could be tweaked to capture just the contents of a web browser control could it?

Trying to effectively save a PDF of the web browser only.

Thanks

Ok here is a much better code than the one I posted before .
This approach is much cleaner mainly because it doesn't require to scroll the embedded webbroser into view plus it will only print the contents of the webbrowser without the background worksheet .. Just as you requested.

1- Code in a Standard Module:

Option Explicit

Type DOCINFO
    cbSize As Long
    lpszName As String
    lpszOutput As String
End Type

#If VBA7 Then
    Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
    Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
    Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Declare PtrSafe Function StretchBlt Lib "gdi32" (ByVal hdc As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    Declare PtrSafe Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As LongPtr
    Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
    Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
    Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Declare PtrSafe Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As LongPtr, lpdi As DOCINFO) As Long
    Declare PtrSafe Function EndDoc Lib "gdi32" (ByVal hdc As LongPtr) As Long
    Declare PtrSafe Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" (ByVal sPrinterName As String, lPrinterNameBufferSize As Long) As LongPtr
    Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
#Else
    Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
    Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
    Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
    Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
    Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function StartDoc Lib "gdi32" Alias "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
    Declare Function EndDoc Lib "gdi32" (ByVal hdc As Long) As Long
    Declare Function GetDefaultPrinter Lib "winspool.drv" Alias "GetDefaultPrinterA" (ByVal sPrinterName As String, lPrinterNameBufferSize As Long) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
#End If

Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const PointsPerInch = 72
Private Const SRCCOPY As Long = &HCC0020
Private Const WM_PRINT = &H317
Private Const PRF_CHILDREN = &H10&
Private Const PRF_CLIENT = &H4&
Private Const PRF_OWNED = &H20&

Function PrintWebBrowserToPDF(ByVal WbBrowser As Object, ByVal OutputFile As String) As Boolean

    #If VBA7 Then
        Dim hwnd As LongPtr, hWebBrowserDc As LongPtr, hPrintDc As LongPtr, hBmp As LongPtr, lMemoryDC As LongPtr, lPtr As LongPtr
    #Else
        Dim hwnd As Long, hWebBrowserDc As Long, hPrintDc As Long, hBmp As Long, lMemoryDC As Long, lPtr As Long
    #End If

    Dim tDocInfo As DOCINFO
    Dim oPrevSheet As Worksheet
    Dim oIa As IAccessible
    Dim wd As Double, hg As Double
    Dim w As Long, h As Long, lZoom As Long
    
    If TypeName(WbBrowser) <> "WebBrowser" Or UCase(Right(OutputFile, 4)) <> ".PDF" Then Exit Function
     
    On Error GoTo Xit
     
    lPtr = ObjPtr(WbBrowser)
    CopyMemory oIa, lPtr, LenB(lPtr)
    WindowFromAccessibleObject oIa, hwnd
    CopyMemory oIa, 0&, LenB(lPtr)
    
    If hwnd Then
        wd = WbBrowser.Width
        hg = WbBrowser.Height
        hWebBrowserDc = GetDC(hwnd)
        lMemoryDC = CreateCompatibleDC(hWebBrowserDc)
        hBmp = CreateCompatibleBitmap(hWebBrowserDc, wd, hg)
        Call SelectObject(lMemoryDC, hBmp)
        hPrintDc = GetPrinterDC()
        If hPrintDc Then
            With tDocInfo
                .lpszName = "WebBrowser_PrintOut"
                .lpszOutput = OutputFile
                .cbSize = Len(tDocInfo)
            End With
            Call StartDoc(hPrintDc, tDocInfo)
                If Not ActiveSheet Is WbBrowser.Parent Then
                    Set oPrevSheet = ActiveSheet
                    Application.ScreenUpdating = False
                    Application.EnableEvents = False
                    WbBrowser.Parent.Activate
                    lZoom = Application.ActiveWindow.Zoom
                    oPrevSheet.Activate
                    Application.EnableEvents = True
                Else
                    lZoom = Application.ActiveWindow.Zoom
                End If
                w = PTtoPX(wd * lZoom / 100, False)
                h = PTtoPX(hg * lZoom / 100, True)
                SendMessage hwnd, WM_PRINT, lMemoryDC, PRF_CHILDREN + PRF_CLIENT + PRF_OWNED
                Call StretchBlt(hPrintDc, 0, 0, GetDeviceCaps(hPrintDc, 8), GetDeviceCaps(hPrintDc, 10), lMemoryDC, 0, 0, w, h, SRCCOPY)
            Call EndDoc(hPrintDc)
        End If
    End If
   
Xit:
   
    Call DeleteObject(hBmp)
    Call DeleteDC(hPrintDc)
    Call DeleteDC(lMemoryDC)
    Call ReleaseDC(hwnd, hWebBrowserDc)
    Application.EnableEvents = True
       
    PrintWebBrowserToPDF = Err.Number = 0 And Len(Dir(CreateObject("Scripting.FileSystemObject").GetParentFolderName(OutputFile), vbDirectory))
End Function

#If VBA7 Then
    Function GetPrinterDC() As LongPtr
    Dim hPrinter As LongPtr
#Else
    Function GetPrinterDC() As Long
    Dim hPrinter As Long
#End If

    Dim sBuffer As String
    Dim sPrinterName As String
    
    sBuffer = Space(128)
    If GetDefaultPrinter(sBuffer, 128) Then
        sPrinterName = Left(sBuffer, 128 - 1)
        GetPrinterDC = CreateDC("WINSPOOL", sPrinterName, vbNullString, 0&)
    End If
End Function

Function ScreenDPI(bVert As Boolean) As Long
   Static lDPI(1), lDC

   If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function

Function PTtoPX(Points As Single, bVert As Boolean) As Long
    PTtoPX = Points * ScreenDPI(bVert) / PointsPerInch
End Function

2- Code Usage : ( This should print to disk Sheet1.WebBrowser1 as a PDF file)

Sub Test()
[B][COLOR=#008000]    'change webbrowser and file path as required.[/COLOR][/B]
    If PrintWebBrowserToPDF(Sheet1.WebBrowser1, "C:\Test\MyWebPDF.PDF") Then
        MsgBox "Success."
    Else
        MsgBox "Fail."
    End If
End Sub

 

[Jaafar Tribak]

Late note:

Needless to say that the above code assumes that the current Default Printer is a PDF printer otherwise it won't work.