Отображение временных сообщений - PullRequest
0 голосов
/ 05 февраля 2020

У меня есть подпрограмма, которая заставляет окно сообщения исчезать через определенное время. Саб отлично работает сам по себе.

Sub MessageBoxTimer()
    Dim AckTime As Integer, InfoBox As Object
    Set InfoBox = CreateObject("WScript.Shell")
    'Set the message box to close after 10 seconds
    AckTime = 10
    Select Case InfoBox.Popup("Click OK (this window closes automatically after 10 seconds).", _
    AckTime, "This is your Message Box", 0)
        Case 1, -1
            Exit Sub
    End Select
End Sub

Когда я внедряю это в свой код, который, между прочим, проверяет, является ли используемая рабочая книга актуальной версией рабочей книги, появляется нужное сообщение, но нет задержки по времени. Есть идеи почему?

Sub test()
    Dim MyPath As Workbook
    Dim WorkbookType As Range
    Dim Version As Long
    Dim CurrentVersion As Long
    Dim SearchRange As Range
    Dim AckTime As Integer, InfoBox As Object

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Version = ThisWorkbook.Worksheets("sheet1").Range("Ver").Value
    WorkbookType = ThisWorkbook.Worksheets("sheet1").Range("Typ").Value

    Set MyPath = Workbooks.Open(Filename:="https://LocationOfTheMasterSpreadsheet.xlsm", _
                               ReadOnly:=True, UpdateLinks:=False)

    Set SearchRange = MyPath.Worksheets("Master").Range("Type")
    Set WorkbookType = SearchRange.Find(What:=WorkbookType, _
                             LookIn:=xlValues, lookat:=xlWhole)
    'Conditions 
    If WorkbookType Is Nothing Then
        MsgBox "No such data found"
    Else
        CurrentVersion = WorkbookType.Offset(0, 1).Value
        If CurrentVersion = Version Then
            AckTime = 1
            Select Case InfoBox.Popup("This is a current version.", _
            AckTime, "This is your Message Box", 0)
            Case 1, -1
            End Select
            Workbooks("MasterExcel.xlsm").Close savechanges:=False
        ElseIf CurrentVersion <> Version Then
            AckTime = 1
            Select Case InfoBox.Popup("This is NOT a current version.", _
            AckTime, "This is your Message Box", 0)
            Case 1, -1
            End Select
            Workbooks("MasterExcel.xlsm").Close savechanges:=False
        End If
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...