Question

Excel VBA，如何在移动到下一行并执行Call之前等待Webbrowser完全加载，请参见下面的代码，任何建议，我们将不胜感激。

尝试使用Worksheet_SelectionChange失败，因为脚本执行ActiveCell。行选择不停止。

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = False
    Sheet1.Cells.Interior.ColorIndex = xlColorIndexNone
    Sheet1.Cells.Borders.ColorIndex = xlColorIndexNone
    Sheet1.Cells(ActiveCell.Row, 3).Interior.ColorIndex = 19
    Sheet1.Cells(ActiveCell.Row, 3).Borders.Color = vbRed
    Sheet1.Cells(1, 3).Interior.ColorIndex = 19
    Sheet1.Cells(1, 3).Borders.Color = vbRed
    Application.ScreenUpdating = True
    Cells(ActiveCell.Row, 1).Select
'HOW TO LOOP Call AutoDomain with using Selection.Offset(1, 0).Select?
'while waiting for webbrowser to completely load before moving to next row and executing Call AutoDomain
'Selection.Offset(1, 0).Select
'AutoDomain
    End
End Sub
Sub AutoDomain()
    Dim xURL As String
    Application.Speech.Speak "Starting Look Up", Speakasync:=True, Purge:=True
    xURL = Cells(ActiveCell.Row, 1)
    Cells(1, 3).Value = ""
    Cells(1, 3).Interior.ColorIndex = xlNone
    Cells(1, 3).Borders.Color = xlNone
    Cells(ActiveCell.Row, 3).Value = ""
    WebBrowser1.Silent = True
    WebBrowser1.Navigate (xURL)
    Sheets(1).Calculate
    End
End Sub
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    WebBrowser1.Stop
    URL = Cells(ActiveCell.Row, 1)
    Cells(1, 3).Value = WebBrowser1.LocationURL
    Cells(1, 3).Interior.ColorIndex = 19
    Cells(1, 3).Borders.Color = vbRed
    Cells(ActiveCell.Row, 3).Value = "DOMAIN : " & WebBrowser1.LocationURL & vbCrLf & "TITLE  : " & WebBrowser1.LocationName
    Do Until Cells(ActiveCell.Row, 3).Value <> ""
        DoEvents
    Loop
    Application.Speech.Speak " Look Up Completed ", Speakasync:=True, Purge:=True
    'SPEECH IS CONTINUING EXTRA TIMES WITHOUT STOPPING SOMETIME, used END to attempt to force speech to stop
    End
End Sub

Answer 1

我使用此自定义子项，在大约90％的情况下，我需要等待页面加载：

Sub Wait()

While (IE.Busy Or IE.READYSTATE <> 4): DoEvents: Wend
Application.Wait (Now + TimeValue("0:00:02"))

End Sub

您需要将IE替换为WebBrowser1。

因此您可以将其放在模块的底部，然后将行更改为：

WebBrowser1.Navigate (xURL): Wait

循环浏览Web浏览器文档完成

1 个答案: