Убедитесь, что книга полностью загружена - PullRequest
0 голосов
/ 10 июня 2019

У меня есть книга Excel с формами и диаграммами. У меня также есть заставка с текстом «Цитата загружается ...» Loading.Show (vbModeless). Я подключил его к Private Sub Workbook_Open(). Однако теперь, когда я открываю книгу, я вижу текстовые поля и формы ActiveX, но диаграммы не загружаются и отображаются серым цветом. Затем я получаю заставку Loading.Show (vbModeless), диаграммы снова серые. Затем заставка исчезает, но диаграммы остаются серыми в течение некоторого времени, и только через пару секунд все загружается.

Есть ли способ показать, например, белый экран (белую книгу) и мой экран-заставку, пока все не будет загружено, включая диаграммы? Я также заметил, что диаграммы загружаются только при открытии конкретного листа. Есть ли способ загрузить их VBA уже на мероприятии Workbook Open?

Я пытался добавить 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...