确保工作簿已完全加载

时间:2019-06-10 09:19:14

标签: excel vba

我有带有形状和图表的Excel工作簿。我还拥有一个启动屏幕,启动屏幕上显示诸如“报价工具正在加载...” Loading.Show (vbModeless)之类的文本。我已将其连接到Private Sub Workbook_Open()。但是,现在当我打开工作簿时,我看到了ActiveX文本框和形状,但图表未加载并显示为灰色。然后我得到了初始屏幕Loading.Show (vbModeless),图表再次变为灰色。然后初始屏幕消失,但图表在一段时间内保持灰色,仅在几秒钟后所有内容都已加载。

有没有办法显示白色屏幕(白色工作簿)和我的启动屏幕,直到包括图表在内的所有内容都被加载?我还注意到只有在打开特定的工作表时才加载图表。有没有办法在Workbook Open事件中通过VBA加载它们?

我尝试添加Application.Wait (Now + TimeValue("00:00:06")),但这似乎使加载时间更长,并且对我想要实现的效果没有实际影响。

这是我当前的代码。

工作簿最小化-最大化

Private Sub Workbook_WindowResize(ByVal Wn As Window)

    Application.ScreenUpdating = False

    Application.DisplayFullScreen = True

    Application.ScreenUpdating = True

End Sub

打开工作簿:

Private Sub Workbook_Open()
    Application.ScreenUpdating = False

    Loading.Show (vbModeless)

    Application.DisplayFormulaBar = False
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False

    Application.DisplayFullScreen = True

    Dim RngCom As Range

    Application.Wait (Now + TimeValue("00:00:06"))

    ThisWorkbook.Worksheets("MAIN").ScrollArea = "$A$1:$BL$45"

    ThisWorkbook.Sheets("MAIN").CommercialBox.Clear
    With ThisWorkbook.Sheets("Contact database")
        For Each RngCom In .Range("B61:B77")
            If RngCom.Value <> vbNullString Then ThisWorkbook.Sheets("MAIN").CommercialBox.AddItem RngCom.Value
        Next RngCom
    End With

    ' This is to ensure ActiveX textboxes are updated and there is text in them 

    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox15").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P2").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox16").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P3").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox17").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P4").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox18").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P5").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox19").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P6").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox20").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P7").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox21").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P8").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox22").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P9").Value

    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox13").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P11").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox14").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P12").Value

    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox7").Object.Text = ThisWorkbook.Sheets("Other Data").Range("Q32").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox8").Object.Text = ThisWorkbook.Sheets("Other Data").Range("P14").Value

    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox10").Object.Text = ThisWorkbook.Sheets("Other Data").Range("Q19").Value
    ThisWorkbook.Sheets("MAIN").OLEObjects("TextBox11").Object.Text = ThisWorkbook.Sheets("Other Data").Range("Q20").Value

    Unload Loading
    Application.ScreenUpdating = True
End Sub

工作簿关闭:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

        Application.ScreenUpdating = False

        Application.DisplayFullScreen = False
        Application.DisplayFormulaBar = True
        ActiveWindow.DisplayHeadings = True
        ActiveWindow.DisplayGridlines = True

        Application.ScreenUpdating = True
End Sub

0 个答案:

没有答案
相关问题