动画 GIF 运行,但仅在脚本完成后运行

问题描述 投票:0回答:1

我创建了一个 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
excel vba animation gif
1个回答
0
投票

非常有趣的想法,我喜欢它。 要在 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,但您可以将其替换为实际脚本。 脚本完成后,卸载用户窗体。

© www.soinside.com 2019 - 2024. All rights reserved.