在其他代码执行时,Gif不会在Excel VBA Form的Webbrowser Control中连续播放

我创build了一个用于获取用户凭据的表单,login我们公司的系统并请求导出。 当点击“Get Exports”button时,显示gif(旋转轮)和文本(首先build立连接,当启动Internet Explorer实例时,应该更改为“Validating User Credentials”)。 我遇到的问题是gif不是一贯的播放,而是在我创build/显示的代码执行完成之后。

单击之前的表单

1

用户表单代码:

Dim progresslbl As Object, progressbar As Object Dim webBr As Object 'vbNewLine for linebreak in msgbox Private Sub GetExports_Click() 'Call FetchExports number = login.number.Text username = login.username.Text password = login.password.Text Label2.Enabled = False Label4.Enabled = False login.number.Enabled = False login.username.Enabled = False login.password.Enabled = False login.Height = login.Height * 1.02 Set webBr = login.Controls.Add("Shell.Explorer.2", "x", True) With webBr .Navigate "C:\Users\Me\Dropbox\Macros\loadspinner.html" .Width = 12 .Height = 12 .Top = Label4.Top + 30 .Left = 17.25 .Visible = True End With Set progresslbl = login.Controls.Add("Forms.Label.1", "Progress", True) With progresslbl .Caption = "Establishing Connection" .Width = 150 .Height = 21.75 .Top = Label4.Top + 31.25 .Left = 32 .Visible = True End With Do While webBr.Busy Or webBr.ReadyState <> READYSTATE_COMPLETE DoEvents 'Starts the loadspinner gif Loop DoEvents 'Call IE instance Call GetIE DoEvents 'Wait for system to get successful instance via loop that tests for control and number of tabs progresslbl.Caption = "Validating User Credentials" login.Height = login.Height * 1.04 Set progressbar = login.Controls.Add("Forms.Label.1", "Progressbar", True) With progressbar .BackColor = RGB(29, 104, 176) .Width = 10 '-> 150 finish .Height = 7.75 .Top = Label4.Top + 47 '280 .Left = 17.25 .Visible = True End With DoEvents ' Do While progressbar.Width <> 150 ' Application.Wait (Now + TimeValue("0:00:01")) ' progressbar.Width = progressbar.Width + 5 ' DoEvents ' Loop 'Proceed with login credentials and wait until we successfully get in (and don't receive popup) End Sub 

模块代码:(我正在使用IE中,这种方法,由于我公司的连接安全有时失去与对象的连接)

 Sub GetIE() Dim targetURL As String: targetURL = "http://companywebsite.com" Set IE = New InternetExplorerMedium IE.Visible = True IE.Navigate targetURL ' Wait while IE loading... On Error Resume Next While IE.Busy DoEvents Wend Do Set sh = New Shell32.Shell For Each eachIE In sh.Windows If InStr(1, eachIE.LocationURL, targetURL) Then Set IE = eachIE 'IE.Visible = False 'This is here because in some environments, the new process defaults to Visible. Exit Do End If Next eachIE Loop Set eachIE = Nothing Set sh = Nothing While IE.Busy ' The new process may still be busy even after you find it DoEvents Wend End Sub 

点击后形成

情况1:直到GetIE()完成后,旋转轮gif才会显示

方案1-1方案1-2

场景2:纺纱轮gif在第一次创build时显示,但即​​使在GetIE()完成后,文本仍然停留在“build立连接”

方案2

我试着用这个答案中提供的方法,但我无法得到它的工作。 也许是因为我使用了晚期绑定?

我的问题:

  1. 一旦我创build/显示,我怎样才能完成gif显示(和播放)?
  2. 我是否正确使用DoEvents ? 我觉得我可能会过度使用它? 我应该如何使用DoEvents
  3. 我怎样才能确保GIF旁边的文本相应地改变(如每个子执行,例如: GetIE() ),并不等到结束,并跳过(或快速通过其他文本)?

Interesting Posts