Excel 循环跟踪webbrowser文档完成

Excel VBA，如何在移动到下一行并执行调用之前等待Webbrowser完全加载，请参阅下面的代码，任何建议都非常感谢

在脚本执行ActiveCell.Row select而不停止时，尝试使用工作表\u SelectionChange但未成功

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

选项显式
专用子工作表\u选择更改（ByVal目标作为范围）
Application.ScreenUpdating=False
Sheet1.Cells.Interior.ColorIndex=xlColorIndexNone
Sheet1.Cells.Borders.ColorIndex=xlColorIndexNone
Sheet1.单元格（ActiveCell.Row，3）.Interior.ColorIndex=19
Sheet1.单元格（ActiveCell.Row，3）.Borders.Color=vbRed
表1.单元格（1,3）.内部颜色索引=19
Sheet1.单元格（1,3）.Borders.Color=vbRed
Application.ScreenUpdating=True
单元格（ActiveCell.Row，1）。选择
'如何使用Selection.Offset（1，0）循环调用AutoDomain。选择？
'等待webbrowser完全加载，然后移动到下一行并执行Call AutoDomain
'选择。偏移量（1，0）。选择
'自动域
终点
端接头
子自动域（）
Dim xURL As字符串
Application.Speech.Speak“开始查找”，Speakasync:=True，Purge:=True
xURL=单元格（ActiveCell.Row，1）
单元格（1，3）。Value=“”
单元格（1,3）.Interior.ColorIndex=xlNone
单元格（1,3）.Borders.Color=xlNone
单元格（ActiveCell.Row，3）。Value=“”
WebBrowser1.Silent=True
WebBrowser1.导航（xURL）
第（1）页。计算
终点
端接头
私有子WebBrowser1_DocumentComplete（ByVal pDisp作为对象，URL作为变体）
WebBrowser1.停下
URL=单元格（ActiveCell.Row，1）
单元格（1,3）.Value=WebBrowser1.LocationURL
单元格（1,3）.Interior.ColorIndex=19
单元格（1,3）.Borders.Color=vbRed
单元格（ActiveCell.Row，3）.Value=“域：”&WebBrowser1.LocationURL&vbCrLf&“标题：”&WebBrowser1.LocationName
直到单元格（ActiveCell.Row，3）为止。值“”
多芬特
环
Application.Speech.Speak“查找完成”，Speakasync:=True，Purge:=True
“讲话是在不停的情况下多持续几次，用结束语试图迫使讲话停止
终点
端接头

我使用这个自定义sub，在我需要等待页面加载的情况下，它可以在90%的情况下工作：

Sub Wait()

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

End Sub

子等待（）
While（即忙碌或就绪状态4）：DoEvents:Wend
Application.Wait（现在+时间值（“0:00:02”））
端接头

您需要将

IE

替换为

WebBrowser1

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

---

webbrowsser1.Navigate（xURL）：等待

调用

单元格（ActiveCell.Row，1）。在
worket\u SelectionChange
中选择

可导致无限循环。谢谢您使用应用程序。等待DocumentComplete。