VBA WebBrowser 捕获全屏答案

【问题标题】：VBA WebBrowser capture full screenVBA WebBrowser 捕获全屏
【发布时间】：2023-03-10 12:15:02
【问题描述】：

希望在 VBA 范围内执行此操作（其他用户没有其他开发工具可修改）。我知道 3rd 方应用程序（例如 iMacros）有类似的功能，但希望尽可能通用。本店使用 XP 和 Excel 2003。

(1) VBA 子程序控制 InternetExplorer 浏览器自动查看网站、提交表单等。

(2) 有没有办法从 WebBrowser 的内容中获取屏幕截图？没有凌乱的 SendKeys 方法？ .NET 有一个 Webbrowser.DrawToBitmap 方法，但找不到 VBA 的简单解决方案。想要整个屏幕，包括“首屏” - 在滚动条下方...

【问题讨论】：

PDF 有什么用？如果是这样，您可以打印。
是的，可以使用 API 来实现，但有点复杂。

标签： vba internet-explorer-8 excel browser

【解决方案1】：

将完整代码粘贴到模块中并运行 Sub Sample()

代码逻辑

1)此代码将打开 IE

2) 导航到 Google.com

3)最大化IE

4) 拍摄快照

5) 启动 MSPaint

6) 在 MSPaint 中粘贴

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Private Const VK_SNAPSHOT As Byte = 44

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal _
nCmdShow As Long) As Long

Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2

Sub Sample()
    Dim IE As Object
    Dim hwnd As Long, IECaption As String

    Set IE = CreateObject("InternetExplorer.Application")
    
    IE.Visible = True
    
    IE.Navigate "www.Google.com"
    
    Sleep 5000
    
    '~~> Get the caption of IE
    IECaption = "Google - Windows Internet Explorer"
    
    '~~> Get handle of IE
    hwnd = FindWindow(vbNullString, IECaption)
    
    If hwnd = 0 Then
        MsgBox "IE Window Not found!"
        Exit Sub
    Else
        '~~> Maximize IE
        ShowWindow hwnd, SW_SHOWMAXIMIZED
    End If
    
    DoEvents
    
    '~~> Take a snapshot
    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)
    
    '~~> Start Paint
    Shell "C:\Windows\System32\mspaint.exe", vbNormalFocus
          
    Sleep 3000
    
    '~~> Paste snapshot in paint
    keybd_event VK_LCONTROL, 0, 0, 0
    keybd_event VK_V, 0, 0, 0
    keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_LCONTROL, 0, KEYEVENTF_KEYUP, 0
End Sub

【讨论】：

在我的测试中，并没有完全得到网页——也得到了滚动条，但这是一个开始。谢谢。
是的，很遗憾，您将获得完整屏幕的快照。这就像在最大化 IE 后按PRINTSCREEN。
您可能需要提高屏幕分辨率以使这些滚动条消失 :)
+1 精彩回答！虽然老实说，我目前正在从我的生活中清除所有谷歌的东西......go duck! 那么，keybd_event 只是支持PrntScrn 的SendKeys 的替代品吗？（SendKeys 没有）它是否存在同样的弱点？
@Jean-FrançoisCorbett：对不起，我没有看到编辑 :) 两者最常见的弱点是将密钥发送到目标应用程序需要目标应用程序处于活动状态。我还在上面的帖子中看到了一个小错误，我已经纠正了

【解决方案2】：

Dim objIe As Object
Set objIe = CreateObject("internetexplorer.application")
    With objIe
        .Navigate "www.google.com"
        '// Set offline JIC user NOT Online
        .offline = True
        '// Maximise the Ie window if not Already Max
        .Visible = True
        '// This routine used to Maximise Ie
        ShowWindow objIe.hwnd, SW_MAXIMIZE
        SetForegroundWindow objIe.hwnd
    End With

Public Const SW_MAXIMIZE As Long = 3       'Show window Maximised
Public Const SW_MINIMIZE As Long = 1       'Show window Minimized

Public Declare Function ShowWindow _
    Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal nCmdShow As Long) _
As Long

Public Declare Function SetForegroundWindow _
    Lib "user32" ( _
    ByVal hwnd As Long) _
As Long

【讨论】：