我创建了一个 GIF,它应该在运行搜索脚本时运行,但它仅在脚本末尾运行(在脚本完成之前它只是 GIF 的图片)。有没有办法让它一直运行?我尝试将 GIF 制作为单独的用户窗体,但在脚本运行时它仍然冻结。我尝试过打开和关闭不同的开关(自动计算、启用事件、屏幕更新),并且尝试更改“执行事件”的位置,但我无法让 GIF 开始动画。
Public Sub SearchButton_Click()
WebBrowser1.Visible = True
WebBrowser1.Navigate "C:\Users\E100676\Pictures\loading.gif"
DoEvents
WebBrowser1.Document.body.Scroll = "no"
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
DoEvents
Dim found As Range, totalcells As Long, B(), nr As Long, nc As Integer, i As Long, j As Integer
Dim Counter As Long, CurrentProgress As Double, ProgressPercentage As Double, BarWidth As Long
nr = WorksheetFunction.CountA(Range(Cells(3, 2), Cells(3, 2).End(xlDown))) + 2
nc = WorksheetFunction.CountA(Range(Cells(2, 2), Cells(2, 2).End(xlToRight))) + 1
ReDim B(3 To nr, 2 To nc)
'create array
For i = 3 To nr
For j = 2 To nc
B(i, j) = Cells(i, j)
Next
Next
'search
Counter = 0
If TextBox1 <> "" Then
For i = 3 To nr
For j = 2 To nc
On Error Resume Next
If InStr(1, B(i, j), CBK200UserForm.TextBox1, vbTextCompare) Then
If IsError(InStr(1, B(i, j), CBK200UserForm.TextBox1, vbTextCompare)) Then
Exit For
End If
Cells(i, 1).Resize(1, nc).Interior.Color = RGB(200, 255, 200)
Counter = Counter + 1
ESkip:
Exit For
End If
Next
Next
If Counter = 0 Then
MsgBox "No search results found.", vbExclamation, "Search Error"
GoTo Skipfilter
End If
If CBK200UserForm.Combo1.ListIndex = -1 Then
Cells(2, 2).AutoFilter field:=2
End If
Else
MsgBox "The search box is empty.", vbInformation, "Search Error"
GoTo Skipfilter
End If
Cells(2, 2).AutoFilter field:=2, Criteria1:=RGB(200, 255, 200), Operator:=xlFilterCellColor
Skipfilter:
WebBrowser1.Visible = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
非常有趣的想法,我喜欢它。 要在 VBA 中运行脚本时显示动画 GIF,可以通过将 UserForm 属性中的 ShowModal 属性更改为 False,将 UserForm 设置为无模式。以下是示例代码:
'In UserForm1
Private Sub UserForm_Initialize()
WebBrowser1.Visible = True
WebBrowser1.Navigate "Path to your animate.gif"
DoEvents
WebBrowser1.Document.body.Scroll = "no"
End Sub
'In some Module
Sub DisplayAnimatedGIF()
' Show the UserForm as modeless
UserForm1.Show vbModeless
' Run your script or code here
For i = 1 To 2000
' Your code logic goes here, for an example, just counting number
ActiveSheet.Range("A1") = i
DoEvents
Next i
' Close the UserForm when the script is done
Unload UserForm1
End Sub
它使用 Show 方法中的 vbModeless 参数将 UserForm1 显示为无模式。这允许显示用户窗体而不会阻止脚本的执行。
您的脚本或代码逻辑在循环内运行。在此示例中,计数为 2000,但您可以将其替换为实际脚本。 脚本完成后,卸载用户窗体。