Задержка DoEvents изменяется для таймера в Word, VBA. Vba задержка
Необходимо создать задержку 30 секунд в Visual Basic
Наилучший подход, который я знаю для этого в VB6, заключается в том, чтобы включить вызов в WaitForSingleObject или другую аналогичную функцию API ожидания в вашем цикле. Хорошим примером такого подхода является функция MsgWaitObj написана Сергей Мерзликин (source article):
Option Explicit '******************************************** '* (c) 1999-2000 Sergey Merzlikin * '******************************************** Private Const STATUS_TIMEOUT = &h202& Private Const INFINITE = -1& ' Infinite interval Private Const QS_KEY = &h2& Private Const QS_MOUSEMOVE = &h3& Private Const QS_MOUSEBUTTON = &h5& Private Const QS_POSTMESSAGE = &H8& Private Const QS_TIMER = &h20& Private Const QS_PAINT = &h30& Private Const QS_SENDMESSAGE = &h50& Private Const QS_HOTKEY = &H80& Private Const QS_ALLINPUT = (QS_SENDMESSAGE Or QS_PAINT _ Or QS_TIMER Or QS_POSTMESSAGE Or QS_MOUSEBUTTON _ Or QS_MOUSEMOVE Or QS_HOTKEY Or QS_KEY) Private Declare Function MsgWaitForMultipleObjects Lib "user32" _ (ByVal nCount As Long, pHandles As Long, _ ByVal fWaitAll As Long, ByVal dwMilliseconds _ As Long, ByVal dwWakeMask As Long) As Long Private Declare Function GetTickCount Lib "kernel32"() As Long ' The MsgWaitObj function replaces Sleep, ' WaitForSingleObject, WaitForMultipleObjects functions. ' Unlike these functions, it ' doesn't block thread messages processing. ' Using instead Sleep: ' MsgWaitObj dwMilliseconds ' Using instead WaitForSingleObject: ' retval = MsgWaitObj(dwMilliseconds, hObj, 1&) ' Using instead WaitForMultipleObjects: ' retval = MsgWaitObj(dwMilliseconds, hObj(0&), n), ' where n - wait objects quantity, ' hObj() - their handles array. Public Function MsgWaitObj(Interval As Long, _ Optional hObj As Long = 0&, _ Optional nObj As Long = 0&) As Long Dim T As Long, T1 As Long If Interval <> INFINITE Then T = GetTickCount() On Error Resume Next T = T + Interval ' Overflow prevention If Err <> 0& Then If T > 0& Then T = ((T + &H80000000) _ + Interval) + &H80000000 Else T = ((T - &H80000000) _ + Interval) - &H80000000 End If End If On Error GoTo 0 ' T contains now absolute time of the end of interval Else T1 = INFINITE End If Do If Interval <> INFINITE Then T1 = GetTickCount() On Error Resume Next T1 = T - T1 ' Overflow prevention If Err <> 0& Then If T > 0& Then T1 = ((T + &H80000000) _ - (T1 - &H80000000)) Else T1 = ((T - &H80000000) _ - (T1 + &H80000000)) End If End If On Error GoTo 0 ' T1 contains now the remaining interval part If IIf((T1 Xor Interval) > 0&, _ T1 > Interval, T1 < 0&) Then ' Interval expired ' during DoEvents MsgWaitObj = STATUS_TIMEOUT Exit Function End If End If ' Wait for event, interval expiration ' or message appearance in thread queue MsgWaitObj = MsgWaitForMultipleObjects(nObj, _ hObj, 0&, T1, QS_ALLINPUT) ' Let's message be processed DoEvents If MsgWaitObj <> nObj Then Exit Function ' It was message - continue to wait Loop End Functionvba - Задержка DoEvents зависит от таймера в Word VBA
Я использовал DoEvents для обеспечения 1-секундной задержки в выполнении VBA, чтобы правильно отображать обратный отсчет в таймере. Используемый код:
Я использовал вышеприведенный код в пределах другого Do Do not Loop. Код показывает обратный отсчет, но задержка между каждым изменением времени изменяется, особенно для части, отображаемой внутри вложенной Do Do not Loop !!
Остальная часть кода:
Sub btnStart_Click() Dim time_2 As Variant g_position = True If g_position = True Then UserForm1.StartUpPosition = 0 UserForm1.Left = Application.Left + 0.5 * Application.Width + UserForm1.Width + 72 UserForm1.Top = Application.Top + (0.5 * Application.Height) - (UserForm1.Height) - 36 End If start = Now timeEnd = start + TimeValue("00:00:10") g_start = Format(start, "hh:mm:ss") g_timeEnd = Format(timeEnd, "hh:mm:ss") time_duration = timeEnd - start g_time_duration = Format(time_duration, "hh:mm:ss") Label1.Visible = True time_left.Caption = g_time_duration time_left.Visible = True btnStart.Visible = False time_2 = Now + TimeValue("00:00:01") Do Until Now >= time_2 DoEvents Loop g_temp = Format(temp, "hh:mm:ss") etime = start + TimeValue("00:00:01") time_duration = timeEnd - etime g_time_duration = Format(time_duration, "hh:mm:ss") time_left.Caption = g_time_duration time_2 = Now + TimeValue("00:00:01") Do Until Now >= time_2 DoEvents Loop Call modtimer.time_count(time_duration, etime, timeEnd, g_time_duration) End SubПочему задержка в обратном отсчете меняется? Может ли кто-нибудь помочь?
qaru.site
Задержки времени в VBA | Programmerz.ru
Мне бы хотелось, чтобы мой код задерживался на 1 секунду. Ниже приведен код, который я пытаюсь сделать задержка. Я думаю, что он проверяет дату и время работы операционной системы и ждет, пока совпадёт время. У меня проблема с задержкой. Я думаю, что он не проверяет время, когда он соответствует времени ожидания, и он просто сидит там и замерзает. Он только зависает примерно в 5% случаев, когда я запускаю код. Мне было интересно о Application.Wait и если есть способ проверить, превышает ли время опроса, чем время ожидания.
newHour = Hour(Now()) newMinute = Minute(Now()) newSecond = Second(Now()) + 1 waitTime = TimeSerial(newHour, newMinute, newSecond) Application.Wait waitTime14
2017-08-05 17:43
источник
Ответы:
Я использую эту небольшую функцию для VBA.
Public Function Pause(NumberOfSeconds As Variant) On Error GoTo Error_GoTo Dim PauseTime As Variant Dim Start As Variant Dim Elapsed As Variant PauseTime = NumberOfSeconds Start = Timer Elapsed = 0 Do While Timer < Start + PauseTime Elapsed = Elapsed + 1 If Timer = 0 Then ' Crossing midnight PauseTime = PauseTime - Elapsed Start = 0 Elapsed = 0 End If DoEvents Loop Exit_GoTo: On Error GoTo 0 Exit Function Error_GoTo: Debug.Print Err.Number, Err.Description, Erl GoTo Exit_GoTo End Function2017-08-05 18:07
Если вы находитесь в Excel VBA, вы можете использовать следующее.
Application.Wait(Now + TimeValue("0:00:01"))(Строка времени должна выглядеть так: H: MM: SS.)
36
2017-09-26 01:00
Вы можете скопировать это в модуль:
Sub WaitFor(NumOfSeconds As Long) Dim SngSec as Long SngSec=Timer + NumOfSeconds Do while timer < sngsec DoEvents Loop End subи всякий раз, когда вы хотите применить паузу, напишите:
Call WaitFor(1)Надеюсь, это поможет!
11
2017-08-05 18:25
Вы пытались использовать Сон?
Вот пример ВОТ (скопировано ниже):
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub Form_Activate() frmSplash.Show DoEvents Sleep 1000 Unload Me frmProfiles.Show End SubОбратите внимание, что это может заморозить приложение в течение выбранного времени.
6
2017-08-05 18:20
Другой вариант ответа Стива Мэллориса, я специально нуждался в превосходстве, чтобы убежать и делать что-то в ожидании, и 1 секунда была слишком длинной.
'Wait for the specified number of milliseconds while processing the message pump 'This allows excel to catch up on background operations Sub WaitFor(milliseconds As Single) Dim finish As Single Dim days As Integer 'Timer is the number of seconds since midnight (as a single) finish = Timer + (milliseconds / 1000) 'If we are near midnight (or specify a very long time!) then finish could be 'greater than the maximum possible value of timer. Bring it down to sensible 'levels and count the number of midnights While finish >= 86400 finish = finish - 86400 days = days + 1 Wend Dim lastTime As Single lastTime = Timer 'When we are on the correct day and the time is after the finish we can leave While days >= 0 And Timer < finish DoEvents 'Timer should be always increasing except when it rolls over midnight 'if it shrunk we've gone back in time or we're on a new day If Timer < lastTime Then days = days - 1 End If lastTime = Timer Wend End Sub2017-08-19 09:30
таймер функция также применяется к Access 2007, Access 2010, Access 2013, Access 2016, Access 2007 Developer, Access 2010 Developer, Access 2013 Developer. Вставьте этот код в паузу на определенное количество секунд
T0 = Timer Do Delay = Timer - T0 Loop Until Delay = 1 'Change this value to pause time in second2
2017-07-02 23:41
Доступ всегда может использовать процедуру Excel, если проект имеет объект Microsoft Excel XX.X ссылка включена :
Call Excel.Application.Wait(DateAdd("s",10,Now()))2
2018-02-11 16:06
programmerz.ru
Доступ / Excel VBA – Задержка времени MS Excel онлайн
Заметка:
-
Обновить таблицы в Excel, связанные с базой данных Access
-
Таблицы в Excel необходимо обновить, например, Test_Sheet1, Test_Sheet2, Test_Sheet3
-
Доступ к файлам Excel осуществляется несколькими пользователями
Вопрос
В Access vba, если используется файл excel (только для чтения), как я могу реализовать задержку в коде доступа vba, чтобы дождаться, когда файл будет прочитан / записан, чтобы он мог продолжить работу с кодом (обновить таблицы, сохранить / закрыть файл). Обратите внимание, что файлы Excel лучше обновлять по порядку.
Я действительно выполнял дескриптор ошибки с задержкой по времени, поэтому, если номер ошибки = 1004, то задержка на X. Это действительно не работа.
Задержки времени в VBA
Function RefreshExcelTables() Dim ExcelApp As Object Set ExcelApp = CreateObject("Excel.Application") ExcelApp.workbooks.Open "c:\test\Test_Sheet1.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close ExcelApp.workbooks.Open "c:\test\Test_Sheet2.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close ExcelApp.workbooks.Open "c:\test\Test_Sheet3.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close Set ExcelApp = Nothing End FunctionВсплывающие сообщения (изображения ниже)
Обновить
Function RefreshExcelTables() On Error GoTo Error Dim ExcelApp As Object Set ExcelApp = CreateObject("Excel.Application") ExcelApp.workbooks.Open "c:\test\Test_Sheet1.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close ExcelApp.workbooks.Open "c:\test\Test_Sheet2.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close ExcelApp.workbooks.Open "c:\test\Test_Sheet3.xlsb" ExcelApp.ActiveWorkbook.refreshall ExcelApp.ActiveWorkbook.Save ExcelApp.ActiveWindow.Close Error: If Err.Number = 1004 Then call pause(5) Resume End If Set ExcelApp = Nothing End Function Public Function Pause(intSeconds As Integer) Dim dblStart As Double If intSeconds > 0 Then dblStart = Timer() Do While Timer < dblStart + intSeconds Loop End If End Function
Solutions Collecting From Web of "Доступ / Excel VBA – Задержка времени"
Я использовал это для приостановки обработки кода:
Public Function Pause(intSeconds As Integer) Dim dblStart As Double If intSeconds > 0 Then dblStart = Timer() Do While Timer < dblStart + intSeconds ' Twiddle thumbs Loop End If End FunctionТаким образом, вы просто: Call Pause(1) где вам нужна пауза, и она будет ждать секунду.
Хорошо работает, если вам нужно только отложить полные секунды. У меня есть еще один надежный вариант с большим количеством кода, который можно использовать для гораздо меньших приращений, если вы хотите его использовать.
excel.bilee.com
vba - Задержка DoEvents изменяется для таймера в Word, VBA
Я использовал DoEvents, чтобы обеспечить 1 вторую задержку в выполнении VBA, чтобы отобразить обратный отсчет таймера должным образом. Код, используемый был:
time2 = Now + TimeValue(00:00:01) Do Until Now >= time2 DoEvents LoopЯ использовал код выше внутри другого Do Until Loop. Код показывает обратный отсчет, но задержка между каждый раз, когда изменяется незначительно, особенно для той части не отображается в гнездовой Do Until Loop !!
Остальная часть кода:
Sub btnStart_Click() Dim time_2 As Variant g_position = True If g_position = True Then UserForm1.StartUpPosition = 0 UserForm1.Left = Application.Left + 0.5 * Application.Width + UserForm1.Width + 72 UserForm1.Top = Application.Top + (0.5 * Application.Height) - (UserForm1.Height) - 36 End If start = Now timeEnd = start + TimeValue(00:00:10) g_start = Format(start, hh:mm:ss) g_timeEnd = Format(timeEnd, hh:mm:ss) time_duration = timeEnd - start g_time_duration = Format(time_duration, hh:mm:ss) Label1.Visible = True time_left.Caption = g_time_duration time_left.Visible = True btnStart.Visible = False time_2 = Now + TimeValue(00:00:01) Do Until Now >= time_2 DoEvents Loop g_temp = Format(temp, hh:mm:ss) etime = start + TimeValue(00:00:01) time_duration = timeEnd - etime g_time_duration = Format(time_duration, hh:mm:ss) time_left.Caption = g_time_duration time_2 = Now + TimeValue(00:00:01) Do Until Now >= time_2 DoEvents Loop Call modtimer.time_count(time_duration, etime, timeEnd, g_time_duration) End SubМодуль Код:
Sub time_count(time_duratn As Variant, etim As Variant, timEnd As Variant, g_time_duratn As Variant) temp_end = Format(TimeValue(00:00:00), hh:mm:ss) temp_alert = Format(TimeValue(00:00:05), hh:mm:ss) etim = etim + TimeValue(00:00:01) time_duratn = timEnd - etim g_time_duratn = Format(time_duratn, hh:mm:ss) UserForm1.time_left.Caption = g_time_duratn time2 = Now + TimeValue(00:00:01) Do Until Now >= time2 DoEvents Loop Do Until g_time_duratn = temp_end If g_time_duratn = temp_alert Then Beep MsgBox Only 5 minutes remaining, vbInformation End If etim = etim + TimeValue(00:00:01) time_duratn = timEnd - etim g_time_duratn = Format(time_duratn, hh:mm:ss) UserForm1.time_left.Caption = g_time_duratn time2 = Now + TimeValue(00:00:01) Do Until Now >= time2 DoEvents Loop Loop End_Exam End SubПочему задержка обратного отсчета изменения? Может кто-нибудь помочь?
coredump.su
