excel vba打印在IE浏览器中打开的文档

Question

我想打印从网页下载的文档，文档已在 IE 浏览器中打开（检查元素选项不存在）使用 send keys 我可以打印它，但如果打印时文件大小更大它显示为正在打印。 Application.Wait 不会帮我确定等待时间，请问有什么办法可以暂停宏的执行，直到打印完成？

用于打印的函数：

Function Sample(tet As Variant)
Dim IE_Tab As SHDocVw.InternetExplorer, ie As InternetExplorer
Dim HTML_Doc As MSHTML.HTMLDocument
Dim SH_Win As SHDocVw.ShellWindows, sh As Object
Dim T_Str As String
Set SH_Win = New SHDocVw.ShellWindows

 For Each IE_Tab In SH_Win
     T_Str = IE_Tab.LocationURL
       If T_Str = tet Then
         Application.Wait (Now + TimeValue("00:00:05"))
         Set sh = CreateObject("WScript.Shell")
         'this command just populates the print dialog box, it worked fine only if i print an web page here iam trying to print a document opened as IE
         IE_Tab.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT, 2, 0
         sh.AppActivate "Print"
         Application.Wait (Now + TimeValue("00:00:02"))
         sh.SendKeys "c", 1
         Application.Wait (Now + TimeValue("00:00:02"))
        sh.SendKeys ("{ENTER}")
         IE_Tab.Quit
            Exit For
     End If
Next
End Function

打印窗口：

进度窗口：

谢谢

Answer 1

在 Windows functions 的帮助下，您可以使用循环“等待”直到您的 “进度” 窗口关闭。

API 函数必须放在模块的顶部（或者更好的是，将其放在它自己的模块中以保持整洁。）

Option Explicit

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Boolean

Sub WaitForWindowToClose(winCaption As String)
'pauses code execution until no window caption (title) matches [winCaption]

    Dim lhWndP As Long, sStr As String
    Dim foundWindow As Boolean, startTime As Single

    'loop through all windows
    lhWndP = FindWindow(vbNullString, vbNullString)
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        'check if this window is a match
        If InStr(1, sStr, winCaption, vbTextCompare) > 0 Then
            Debug.Print "Found Window: " & sStr & " (#" & lhWndP & ")"
            foundWindow = True
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, 2)
    Loop

    If Not foundWindow Then
        Debug.Print "Window '" & winCaption & "' not found."
        Exit Sub
    End If

    'check if window still exists
    Do While FindWindow(vbNullString, sStr) <> 0 And IsWindowVisible(lhWndP)
        'pause for a quarter second before checking again
        startTime = Timer
        Do While Timer < startTime + 0.25
            DoEvents
        Loop
    Loop
    Debug.Print "Window no longer exists."
End Sub

示例用法：

WaitForWindowToClose "progress"

...暂停代码的执行，直到在其标题栏中没有带有 progress 的打开窗口。

该过程会查找不区分大小写的部分匹配项，因为窗口标题并不总是它们看起来的样子。

这应该不是问题，除非您打开另一个窗口，其中的标题与您等待的窗口类似。例如，progress 可以指您打印机的进度窗口，或称为“Progressive Insurance”的浏览器窗口。

---

疑难解答：

以下步骤对于上述操作不是必需的，但我想我还是将它们包括在内，以进行故障排除（即，以防您在识别打印机的进度窗口时遇到问题）。

用法应该是不言自明的：

Sub ListAllVisibleWindows()
    'Lists all named, visible windows in the Immediate Window
    Dim lhWndP As Long, sStr As String
    lhWndP = FindWindow(vbNullString, vbNullString)
    Do While lhWndP <> 0
        x = x + 1
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        If Len(sStr) > 1 And IsWindowVisible(lhWndP) Then
            GetWindowText lhWndP, sStr, Len(sStr)
            Debug.Print "#" & x, lhWndP, sStr
        End If
        lhWndP = GetWindow(lhWndP, 2)
    Loop
End Sub

Public Function IsWindowOpen(winCaption As String) As Boolean
    'returns TRUE if winCaption is a partial match for an existing window
    Dim lhWndP As Long, sStr As String
    lhWndP = FindWindow(vbNullString, vbNullString)
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        If InStr(1, sStr, winCaption, vbTextCompare) > 0 Then
            Debug.Print "Found Window: " & sStr & " (#" & lhWndP & ")"
            IsWindowOpen = True
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, 2)
    Loop
End Function

_{（代码改编自here。）}