Как открыть рабочую книгу, пока макрос выполняется в другой книге? - PullRequest
0 голосов
/ 08 февраля 2019

У меня возникла проблема, когда я создал таймер VBA, который ведет обратный отсчет от указанного времени до нуля.Этот макрос запускается некоторое время, поэтому когда я пытаюсь открыть другую книгу, ничего не происходит, это как макрос блокирует открытие другой книги?

Мой таймер sub

Private Sub Timer15_main(play As Boolean)
 Dim UserInput As String

    If play Then
      UserInput = TextBox1.Value 'this is what the user inputs and how long the timer should run
     Else
      timer_15_pause_button = False
      UserInput = "00:15:00" 'this is what the user inputs and how long the timer should run
    End If

        'validate userinput und ensure hh:mm:ss format
        Select Case Len(UserInput) - Len(Replace$(UserInput, ":", ""))
            Case 2 'input format is hh:mm:ss

            Case 1 'input format is mm:ss
                UserInput = "00:" & UserInput
            Case 0 'input format is ss
                UserInput = "00:00:" & UserInput
            Case Else
                MsgBox "invalid input"
                Exit Sub
        End Select

        'we need to convert the string UserInput into a double and
        'convert it into seconds (Timer uses seconds!)
        Dim SecondsToRun As Long
        SecondsToRun = CDbl(TimeValue(UserInput)) * 24 * 60 * 60
         TextBox4.Value = Format$((SecondsToRun / 24 / 60 / 60) + Time(), "hh:mm:ss")
        Dim TimerStart As Double
        TimerStart = Timer 'remember when timer starts

        Do

             If SecondsToRun - (Timer - TimerStart) < 10 Then
             TextBox1.BackColor = RGB(255, 0, 0)
            End If

            TextBox1.Value = Format$((SecondsToRun - (Timer - TimerStart)) / 24 / 60 / 60, "hh:mm:ss")
            'count backwards from 01:15 format as hh:mm:ss

            DoEvents
            If timer_15_pause_button = True Then
            Exit Sub
            End If


        Loop While TimerStart + SecondsToRun > Timer 'run until SecondsToRun are over
        TextBox1.BackColor = RGB(255, 255, 255)

        'TextBox4.Value = ""

        End Sub

1 Ответ

0 голосов
/ 08 февраля 2019

Предполагается, что форма отображается следующим образом:

UserForm1.Show
DoSomething

Тогда форма будет модальной , что означает, что вызов DoSomething не будет выполняться, пока форма не будет закрыта.Пока отображается модальная форма, она управляет циклом сообщений, и хост-приложение все время недоступно: единственное, с чем пользователь может взаимодействовать, это форма.

Если форма отображается следующим образом:

UserForm1.Show vbModeless
DoSomething

Затем отображается форма, и вызов DoSomething выполняется немедленно;пользователь по-прежнему может взаимодействовать с хост-приложением, а код в форме может выполняться асинхронно.

Но такой цикл выглядит так:

Do
    ' do stuff
    DoEvents
Loop While {condition}

Плохой дизайн: без DoEventsЦикл будет полностью перехватывать цикл сообщений, модальное или немодальное не будет иметь значения, и приложение хоста, скорее всего, будет идти (не отвечая), пока цикл не завершится. С DoEvents это занятая петля, постоянно говорящая Windows: «Эй, у вас есть что запустить?- что вы хотите сделать, это зарегистрировать процедуру, которая будет вызываться раз в секунду для обновления метки таймера в форме.

Эта процедура должна быть в отдельном стандартном модуле - в идеале тот же модуль, которыйпоказ формы и, в идеале, отработка того же экземпляра этой формы.

Option Explicit
Private theForm As UserForm1

Public Sub ShowTheForm()
    If theForm Is Nothing Then Set theForm = New UserForm1
    theForm.Show vbModeless
End Sub

Public Sub OnTimerTick()
    If theForm Is Nothing Then Exit Sub
    theForm.HandleTimerTick
End Sub

Теперь форме необходимо предоставить процедуру HandleTimerTick и запланировать макрос OnTimerTick.Таким образом, у вас может быть элемент управления CommandButton, который при щелчке запускает цикл планирования:

Dim TimerStart As Double

Private Sub CommandButton1_Click()
    ' validate inputs...
    TimerStart = Timer
    Application.OnTime Now + TimeValue("00:00:01"), "OnTimerTick"
End Sub

Public Sub HandleTimerTick()
    'timer has ticked, we're at least 1 second later.
    Dim secondsElapsed As Double
    secondsElapsed = Timer - TimerStart

    'update the textbox accordingly...
    TextBox1.Text = Format$(secondsToRun - secondsElapsed, "hh:mm:ss")

    'now determine if we need to schedule another tick:
    If Int(secondsToRun - secondsElapsed) > 0 Then
        Application.OnTime Now + TimeValue("00:00:01"), "OnTimerTick"
    End If
End Sub

Обратите внимание, что больше нет явного цикла, нет DoEvents: просто запланированный макрос, который сообщает форме "эйтам, галочка!и форма отвечает, обновляя себя и, при необходимости, перепланируя другой тик.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...