Разное

Vba таймер: Excel VBA ТАЙМЕР | Как использовать функцию таймера VBA?

Содержание

Excel VBA ТАЙМЕР | Как использовать функцию таймера VBA?

ТАЙМЕР VBA

Excel VBA TImer используется для обнаружения и расчета времени, затраченного на выполнение любого действия. В Excel функция VBA TIMER может использоваться разными способами. Мы можем рассчитать время для завершения любого действия, мы можем рассчитать время, необходимое для достижения от начальной до конечной фазы любого действия, или даже мы можем рассчитать время, необходимое для нажатия на любую функцию.

Эта функция не может быть выполнена в Excel. В Excel мы можем только видеть время и добавлять его в любую ячейку, но не можем измерить его как Таймер.

Вы можете скачать этот шаблон VBA TIMER Excel здесь — Шаблон VBA TIMER Excel

Пример № 1

В этом примере мы узнаем, как подсчитать или измерить время для запуска завершенного кода. Для этого перейдите в меню VBA и выберите модуль, как показано ниже.

Как только мы это сделаем, он откроет новый модуль, как показано ниже. Теперь в этом напишите Подкатегорию текущего имени функции или любого другого имени согласно вашему выбору.

Код:

 Sub Timer1 () End Sub 

Теперь определим два измерения как Seconds1 и Seconds2 как SINGLE- функцию, что означает наличие двух отдельных данных с одним номером (без десятичной дроби).

Код:

 Sub Timer1 () Dim Seconds1 как одиночный Dim Seconds2 как одиночный конец Sub 

Теперь для запуска таймера сначала выберите определенный размер Seconds1 и назначьте функцию TIMER . И сделайте то же самое для другого измерения Seconds2, как показано ниже. Цель состоит в том, чтобы измерить время начала и окончания.

Код:

 Sub Timer1 () Dim Seconds1 как отдельные Dim Seconds2 как отдельные секунды1 = Timer () Seconds2 = Timer () End Sub 

Это завершает часть таймера кода. Теперь нам нужно увидеть промежуток времени при запуске кода. Для этого нам нужно распечатать вывод в окне сообщения, как показано ниже.

На скриншоте ниже мы напечатали текст «Время потрачено:» и разницу между секундами2 и секундами1 с единичными секундами.

Код:

 Sub Timer1 () Dim Seconds1 как отдельные Dim Seconds2 как отдельные секунды1 = Timer () Seconds2 = Timer () MsgBox («Время истекло:» & vbNewLine & Seconds2 - Seconds1 & «seconds») End Sub 

После этого запустите полный код, нажав клавишу F5 или нажав кнопку воспроизведения, как показано ниже.

Мы увидим окно сообщения со счетным временем 0 секунд, так как время, необходимое для выполнения полного кода, было 0.

Мы можем увидеть немного больше различий, если написанный код огромен.

Пример № 2

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

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

Код:

 Sub Timer2 () End Sub 

Теперь, чтобы сделать этот код небольшим и простым, мы будем использовать встроенные функции VBA. И для этого типа приложение следует за точкой (.), А затем из списка поиска и выберите функцию ожидания, как показано ниже.

Эта функция ожидания позволит нам добавить время ожидания, пока весь код не будет запущен. Это время ожидания логическое. После этого рассмотрим время, когда мы запускаем, это 0 секунд со временем плюс, которое мы хотим показать, поскольку время ожидания будет показано TimeValue, как показано ниже.

Код:

 Sub Timer2 () Application.Wait Now + TimeValue ("00:00:10") End Sub 

Здесь мы считаем 10 секунд временем ожидания завершения кода.

Теперь, чтобы напечатать время ожидания, нам нужно напечатать сообщение в окне сообщения с помощью команды MsgBox, как показано ниже.

Код:

 Sub Timer2 () Application.Wait Now + TimeValue ("00:00:10") MsgBox ("Время ожидания - 10 секунд") End Sub 

Как мы видим, в окне сообщения добавлен текст « Время ожидания — 10 секунд » для печати.

Теперь запустите код, используя клавишу F5 или вручную. Мы увидим, что после 10 секунд ожидания появится окно с сообщением, использованным в коде.

Пример № 3 — Таймер VBA

Существует еще один простой способ увидеть и показать текущее время в VBA. Для этого мы будем напрямую использовать только MsgBox и остальную часть кода. Для этого откройте новый модуль в VBA и напишите Subcategory во имя используемой функции или любое другое имя, как показано ниже.

Код:

 Sub Timer3 () End Sub 

Теперь напишите MsgBox, который является командой для печати сообщения. В скобках мы можем написать любое сообщение для печати в окне сообщения. Здесь мы выбрали « Time is: » в качестве нашего текста и вместе с ним « & Now () ». Во всплывающем окне появится текущее время с датой.

Код:

 Sub Timer3 () MsgBox («Время:» & Now ()) End Sub 

Теперь в другом окне сообщения мы посчитаем количество секунд, прошедших за часы до текущего времени по часам. Для этого напишите MsgBox и между скобками напишите « Timer is: » вместе с « & Timer () », как показано ниже.

Код:

 Sub Timer3 () MsgBox («Время:» и сейчас ()) MsgBox («Таймер:» и таймер ()) End Sub 

После этого запустите код с помощью клавиши F5 или вручную. Мы получим два отдельных окна сообщений, как показано ниже.

В первом окне сообщения мы получим текущую дату и время в формате ДД / ММ / ГГГГ и формате чч: мм: сс AM / PM, который является форматом Excel по умолчанию. Во втором окне сообщения мы увидим время, прошедшее в тот день в секундах.

Во втором окне сообщения отображается Таймер 59953, 62 секунды. Если мы разделим это на 60 секунд и 60 минут, мы получим точный таймер в часах, прошедших в тот день, который составляет 16, 65 часов .

Что нужно знать о VBA TIMER

  • Всегда сохраняйте файл в Marco Enabled Workbook, чтобы избежать потери написанного кода VBA.
  • Всегда компилируйте полный код шаг за шагом, чтобы убедиться, что каждый код неверен.
  • В примере # 1 функция SINGLE используется для отображения числа в целом. Даже если мы используем DOUBLE, это даст результат в десятичном виде.

Рекомендуемые статьи

Это было руководство по Excel VBA TIMER. Здесь мы обсудили, как использовать функцию VBA TIMER вместе с некоторыми практическими примерами и загружаемым шаблоном Excel. Вы также можете просмотреть наши другие предлагаемые статьи —

  1. Как использовать VBA On Error Statement?
  2. Числовой формат в VBA
  3. Как использовать функцию поиска VBA?
  4. Учебники по функции VBA TRIM

Таймер в Excel / Sandbox / Habr

Не помню кто из великих сказал… И не помню что. Но в процессе разработки vba-приложений время от времени возникает необходимость использовать таймер. «Из коробки» решения, к сожалению, нет.

Application.OnTime?

Данный метод отложенных вызовов сам по себe решает проблему, но лишь один раз. В том смысле, что таймер срабатывает лишь единожды — указать переодичность вызовов, увы, нельзя.

Application.OnTime + рекурсия?

Очевидно, что в конце необходимой процедуры можно вызывать её же с помощью данного метода, но не менее очевидны и недостатки этого решения — отсутствие достаточного контроля и неудобство вызова:

  • не таймер вызывает действие;
  • чтобы остановить цикл придётся объявлять глобальную переменную;
  • добавление «костыля» в тело отдельно взятой процедуры. Если в следующий раз будет нужно вызвать по таймеру другую — то и в неё придётся переносить данный «костыль».

Evaluate в помощь?

Написать свой класс и вызывать внутри необходимую процедуру с помощью Application.Evaluate. Особо упорные в стремлении создать приемлемый метод вызова таймера доходят до этого решения и упираются в стран/ш/ный баг, отловить который достаточно сложно: udf-функция переданная в переменной будет вызываться каждый раз по два(!) раза.

Потому что гладилус

Способ обойти этот баг пока найден лишь один:

ActiveSheet.Evaluate "0+" & nameOfProcedure

Решение

Для простоты вызова написан не класс, а метод. Достаточно указать интервал, имя вызываемой процедуры и, опционально, кол-во необходимых вызовов:

StartTimer 60, "CalculateTotal()", 30 'вызов CalculateTotal() каждую минуту в течении получаса.
StopTimer 'остановка таймера

модуль

Option Explicit

Private Type Timer
    interval As Long
    procedure As String
    times As Long
    enabled As Boolean
    initialized As Boolean
    ticks As Long
End Type

Private Timer As Timer

Public Sub StartTimer(ByRef interval As Long, _
                      ByRef procedure As String, _
                      Optional ByRef times As Long)
With Timer
    .interval = interval
    .procedure = procedure
    .times = times
    .enabled = True
    .initialized = False
    .ticks = 0
End With

InvokeTimer
End Sub

Public Sub StopTimer()
Timer.enabled = False
End Sub

Private Function InvokeTimer()
If Timer.ticks > Timer.times And Not Timer.times = 0 Then StopTimer
If Not Timer.enabled Then Exit Function

If Timer.initialized Then
    ActiveSheet.Evaluate "0+" & Timer.procedure
Else
    Timer.initialized = True
End If

Timer.ticks = Timer.ticks + 1

Application.OnTime Now + 1 / 86400 * Timer.interval, "InvokeTimer"
End Function

Excel VBA: как реализовать таймер для проверки таймаута кода

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

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

Проблема, с которой я столкнулся, возникает, когда пользователь сопоставил несколько общих каталогов со своим компьютером и, таким образом, имеет несколько дисков… Пример: 1 каталог находится на диске G:, а другой-на диске X:.

Если они выберут диск для общего каталога, в котором находится книга, проблем не возникнет. Однако если они случайно выберут диск для другого общего каталога, код зависнет.

У меня есть настройка цикла, которая проверяет, что они выбрали правильный диск… IE: если они выбрали a: (несуществующий диск в моем примере), то код заметит, что они выбрали неправильный диск, и снова запросит их.

Однако вместо того, чтобы создавать ошибку при выборе другого общего каталога, код просто зависает.

В приведенном ниже коде ячейка AD3 на первом листе содержит true или false (получает значение false в начале подзаголовка). Он получает значение true, если они выбрали правильный диск, так как Module6.PipelineRefresh больше не будет вызывать ошибку (этот суб пытается открыть книгу на общем диске… и если выбранный диск неверен, он, очевидно, возвращает ошибку)

Коды таковы, как показано ниже:

Do While Sheet1.Range("ad3") = False
    On Error Resume Next
        Call Module6.PipelineRefresh  '~~ I'm guessing the code hangs here.  Instead of returning an error immediately, as it would if they simply chose a non-existant drive, it appears to get stuck trying to open the workbook, even though it's not located in the shared directory they've selected.
    If Err.Number = 0 Then
        Sheet1.Range("ad3") = True
        Err.Clear
    Else
        MsgBox "Invalid Network Drive."
        DriverSelectForm.Show
        Err.Clear
    End If
Loop

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

Кроме того, если вы знаете, как обойти эту ошибку, это тоже было бы здорово!

EDIT согласно комментарию:

Это специфический код в Module6.PipelineRefresh , который зависает. DriverSelectForm (показано выше) изменяет значение в ячейке o1 на выбранную строку привода (то есть: X:)

Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook
Dim xlz As String
xlz = Sheet1.Range("o1").Value & "\Region Planning\Created Pipeline.xlsx"
Dim WS As Worksheet
Dim PT As PivotTable

Application.DisplayAlerts = False
Set xlw = xlo.Workbooks.Open(xlz)
Application.DisplayAlerts = True

Примечание: как указано выше, если пользователь выбирает несуществующий каталог, приведенный выше код немедленно возвращает ошибку, поскольку он не может открыть файл… если у них есть общий каталог, сопоставленный с выбранным диском (но это неправильный каталог), код будет зависать и не будет возвращать ошибку.

vba

excel

timer

Поделиться

Источник


Sam WB    

13 мая 2013 в 10:03

2 ответа


  • Как создать автоматический таймер с помощью редактора макросов Excel 2016 VBA?

    Мне нужно создать таймер в Редакторе Excel 2016 VBA, который будет срабатывать каждую секунду и отображать сообщение. У меня есть простой код, который будет делать именно это; однако, когда я запускаю код, появляется окно сообщения, а затем следует ошибка. Мой код представлен ниже: Private Sub…

  • Excel VBA чтение списка проверки в переменную

    Я пытался найти код Excel VBA, который считывает список проверки в переменную. Я использую версию Excel 2010. В приведенном ниже коде я динамически настраиваю значения с помощью переменной qNR и появляюсь в выпадающем меню. Позже мне нужно прочитать значения в списке проверки, удалить или обновить…



2

Я ответил на свой собственный вопрос, работая над проблемой. Вместо того чтобы проверять, что пользователь выбрал правильную букву диска, я теперь использую функцию CreatObject , чтобы найти букву диска, связанную с именем диска (так как имя диска не изменится).

Пример кода для этого:

Dim objDrv      As Object
Dim DriveLtr      As String

For Each objDrv In CreateObject("Scripting.FileSystemObject").Drives
    If objDrv.ShareName = "Shared Drive Name" Then
        DriveLtr = objDrv.DriveLetter
    End If
Next

If Not DriveLtr = "" Then
    MsgBox DriveLtr & ":"
Else
    MsgBox "Not Found"
End If
Set objDrv = Nothing

Поделиться


Sam WB    

13 мая 2013 в 14:00



1

Решение для остановки некоторого кода по таймеру. Код должен быть помещен в модуль.

Private m_stop As Boolean
Sub stop_timer(p_start_time As Variant)
  Application.OnTime p_start_time, "stop_loop"
End Sub
Sub signal_timer(p_start_time As Variant)
  Application.OnTime p_start_time, "signal_in_loop"
End Sub
Sub test_loop()
  Dim v_cntr As Long
  m_stop = False
  v_cntr = 0
  stop_timer Now + TimeValue("00:00:05")
  signal_in_loop
  While Not m_stop
    v_cntr = v_cntr + 1
    DoEvents
  Wend
  Debug.Print "Counter:", v_cntr
End Sub
Sub stop_loop()
  m_stop = True
End Sub
Sub signal_in_loop()
  Debug.Print "timer:", Timer
  If Not m_stop Then
    signal_timer Now + TimeValue("00:00:01")
  End If
End Sub

Выход:

timer:         50191.92 
timer:         50192 
timer:         50193 
timer:         50194 
timer:         50195 
timer:         50196 
Counter:       67062 
timer:         50197.05 

m_stop управляет циклом. DoEvents вызывает обработчики событий, такие как stop_loop и signal_in_loop, как отложенные процедуры.

Поделиться


Aleksey F.    

29 октября 2014 в 11:03


Похожие вопросы:

Как провести модульный тест Excel VBA кода

Есть ли у кого-нибудь опыт модульного тестирования кода Excel VBA? Я хочу как можно безболезненнее внедрить модульные тесты в какой-нибудь устаревший код Excel VBA. Одна из моих идей состояла в том,…

Таймер на форме пользователя в Excel VBA

У меня есть какой-то старый код Excel VBA, где я хочу запускать задачу через регулярные промежутки времени. Если бы я использовал VB6, я бы использовал элемент управления таймером. Я нашел метод…

Как вызвать событие IE ‘onblur’ из кода VBA в коде Excel?

Ситуация: я работаю над заполнением полей ввода текста на веб-странице данными из Excel. Когда данные вводятся вручную и фокус перемещается в другое текстовое поле, запускается событие ‘onblur’ для…

Как создать автоматический таймер с помощью редактора макросов Excel 2016 VBA?

Мне нужно создать таймер в Редакторе Excel 2016 VBA, который будет срабатывать каждую секунду и отображать сообщение. У меня есть простой код, который будет делать именно это; однако, когда я…

Excel VBA чтение списка проверки в переменную

Я пытался найти код Excel VBA, который считывает список проверки в переменную. Я использую версию Excel 2010. В приведенном ниже коде я динамически настраиваю значения с помощью переменной qNR и…

VBA Excel реализовать COUNTIF функцию

Я пытаюсь реализовать функцию COUNTIF() в своем приложении vba excel. Я знаю, как сделать это программно,но я хочу специально реализовать это как формулу, чтобы последующие изменения в листе…

Комментирование / Раскомментирование кода VBA в Excel для Mac 2016

Я видел сообщения о том, как комментировать / раскомментировать блоки кода VBA в Excel, но все они, похоже, связаны с Excel для Windows. Я не могу найти подобный метод комментирования больших блоков…

Как реализовать формулы Excel в vba

Сейчас я программирую инструмент на VBA, и у меня возникла проблема с написанием формулы IF . У меня есть два листа site и overview, я хотел бы написать формулу IF для столбца диапазона листа site…

Ошибка таймаута запроса Excel VBA

Я пытаюсь запустить запрос SQL Server через Excel VBA, который дает мне следующую ошибку. Я протестировал этот запрос в SQL Server Management Studio &, он работает совершенно нормально. Он…

Как реализовать динамическую проверку данных, например, как Excel VBA-функция?

Проверка данных в Excel-это полезный способ проверки ввода данных Пользователем в Excel. Стандартный способ состоит в том, чтобы (1) определить где-то (например, на вспомогательном листе) список с…

excel — Таймер VBA — вычесть время ожидания ввода пользователя

Я использую этот метод, найденный на сайте thespreadsheetguru.com, для расчета времени, необходимого для запуска макроса:

Sub CalculateRunTime_Minutes()
'PURPOSE: Determine how many minutes it took for code to completely run
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim StartTime As Double
Dim MinutesElapsed As String

'Remember time when macro starts
  StartTime = Timer

'*****************************
'Insert Your Code Here...
'*****************************

'Determine how many seconds code took to run
  MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

'Notify user in seconds
  MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation

End Sub

У меня он отлично работает, но в моем коде есть несколько запросов для ввода пользователем. Некоторые из них просто кнопки ОК, а другие представляют собой пользовательские формы с несколькими кнопками.

Как я могу рассчитать время, необходимое для запуска макроса, за вычетом времени, затрачиваемого на ожидание нажатия пользователем кнопки?

1

Robby

4 Авг 2017 в 22:52

2 ответа

Лучший ответ

Основываясь на вашем коде, примерно так:

Sub CalculateRunTime_Minutes()
Dim StartTime1 As Double, StartTime2 As Double, StartTime3 As Double
Dim StopTime1 As Double, StopTime2 As Double
Dim MinutesElapsed As String

StartTime1 = Timer
'your code
StopTime1 = Timer
'user input1

StartTime2 = Timer
'your code
StopTime2 = Timer
'user input2

StartTime3 = Timer
'your code
MinutesElapsed = Format(((Timer - StartTime3) + (StopTime2 - StartTime2) + (StopTime1 - StartTime1)) / 86400, "hh:mm:ss")

MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation

End Sub

2

Tehscript
4 Авг 2017 в 20:06

Можете ли вы реализовать какую-то проверку PauseTime?

Мой VBA далеко, но …

Dim arrayPausetime() as double
Dim formStartTime as double
Dim formStopTime as double.

Каждый раз, когда вы запускаете свои формы, требующие ввода данных пользователем, вы берете метку времени formStartTime, то же самое, когда вы выходите из этой формы … formStopTime.

Добавьте (formStopTime — formStartTime) в свой arrayPausetime и в конец вашего макроса:

dim finalTime as double

for each (double pausetime in arrayPausetime) 
     finalTime  = finalTime  + (Timer - StartTime) - pausetime

Надеюсь, это поможет мозговому штурму! 🙂

2

Windrider
4 Авг 2017 в 20:05

45514529

vba — Таймер в форме пользователя в Excel VBA

Мне нужен был видимый таймер обратного отсчета, который мог бы оставаться поверх других окон и плавно работать независимо от того, изменяете ли вы рабочую книгу или сворачиваете окно Excel. Итак, я адаптировал креативный код выше для моих собственных целей и решил, что я поделился бы результатом.

В приведенном ниже коде требуется создание модуля и пользовательской формы, как указано в комментариях, или вы можете загрузить .xlsm в нижней части этого ответа.

Я использовал Windows Timer API для более точного и плавного обратного отсчета (и также можно настроить до ~ 100 миллисекунд разрешение по таймеру , в зависимости от вашего процессора Существует даже «tick tock» звук .⏰

Вставьте новый модуль и сохраните его как modUserFormTimer . Добавьте два формы команд управления на рабочий лист с надписью Start Timer и Stop Timer и назначены процедуры btnStartTimer_Click и btnStopTimer_Click .

Option Explicit 'modUserFormTimer

Public Const showTimerForm = True 'timer runs with/without the userform showing
Public Const playTickSound = True 'tick tock (a WAV sounds could be embedded: `https:// goo.gl/ ReuUyd`)
Public Const timerDuration = "00:00:20" 'could also Insert>Object a WAV for tick or alarm
Public Const onTimerStart_MinimizeExcel = True 'minimize Excel? (countdown remains visible)
Public Const onTimerStart_MaximizeExcel = True 'maximize Excel when timer completes?
'timer could be on top of other applications; instructions here: `https:// goo.gl/ AgmWrM`

'safe for 32 or 64 bit Office:
Private Declare PtrSafe Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public Declare PtrSafe Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Public schedTime As Date 'this is the "major" timer set date
Private m_TimerID As Long

Public Sub OnTimerTask()
'the procedure that runs on completion of the "major timer" (timer won't reschedule)
    Unload frmTimer

    ''''''''''''''''''''''''''''''
    MsgBox "Do Something!"       '  0 Then
            m_TimerID = SetTimer(0, 0, Duration, AddressOf TimerEvent)
            If m_TimerID = 0 Then
                MsgBox "Timer initialization failed!", vbCritical, "Timer"
            End If
        Else
            MsgBox "The duration must be greater than zero.", vbCritical, "Timer"
        End If
    Else
        MsgBox "Timer already started.", vbInformation, "Timer"
    End If
End Sub

Public Sub StopTimer()
    If m_TimerID  0 Then 'check if timer is active
        KillTimer 0, m_TimerID 'it's active, so kill it
        m_TimerID = 0
    End If
End Sub

Private Sub TimerEvent()
'the API calls this procedure
    frmTimer.OnTimer
End Sub

Затем создайте пользовательскую форму, сохраните ее как frmTimer . Добавьте текстовое поле с именем txtCountdown . Установите свойство ShowModal в False . Вставьте следующее в окно кода формы:

Option Explicit 'code for userform "frmTimer"
'requires a textbox named "txtCountdown" and "ShowModal" set to False.

Dim nextTriggerTime As Date

Private Sub UserForm_Initialize()
    ScheduleNextTrigger
End Sub

Public Sub UserForm_Terminate()
    StopTimer
    If schedTime > 0 Then
        schedTime = 0
    End If
    If onTimerStart_MaximizeExcel Then Application.WindowState = xlMaximized 'maximize excel window
    Unload Me
End Sub

Private Sub ScheduleNextTrigger() 'sets the "minor" timer (for the countdown)
    StartTimer (1000) 'one second
End Sub

Public Sub OnTimer()
'either update the countdown, or fire the "major" timer task
    Dim secLeft As Long
    If Now >= schedTime Then
        OnTimerTask 'run "major" timer task
        Unload Me  'close userForm (won't schedule)
    Else
        secLeft = CLng((schedTime - Now) * 60 * 60 * 24)
        If secLeft  60 * 60 Then
                txtCountdown = Format(secLeft/60/60/24, "hh:mm:ss")
            Else 'between 59 and 1 minutes remain:
                txtCountdown = Right(Format(secLeft/60/60/24, "hh:mm:ss"), 5)
            End If
        End If
       If playTickSound Then Beep 16000, 65 'tick sound
    End If
End Sub

Download the demo .xksm. here. There are numerous ways this can be customized or adapted to specific needs. I’m going to use it to calculated and display real time statistics from a popular Q&A site in the corner of my screen…

Примечание , поскольку, поскольку он содержит макросы VBA, файл может содержать ваш антивирусный сканер (как и в любом другом нелокальном файле с VBA). Если вы заинтересованы, не загружайте и вместо этого создавайте его с предоставленной информацией.)

Execute Command / Подпроцедура Использование VBA Таймер

В этой статье мы создадим макрос для вызова другого макроса или выполнения команды через определенные промежутки времени.

Чтобы выполнить макрос, нажмите кнопку «Запустить таймер».

При запуске макроса макрос «TimerMsg» отобразит окно сообщения.

Когда пользователь нажимает кнопку «ОК», через три секунды будет вызван макрос «MsgProcedure». Макрос «MsgProcedure» отобразит окно сообщения.

Логическое объяснение

В этом примере мы создали два макроса «TimerMsg» и «MsgProcedure». Макрос «TimerMsg» ** отображает информационное сообщение и вызывает «MsgProcedure» после ожидания в течение трех секунд, как определено в коде.

Объяснение кода

Метод Application.OnTime

Метод Application.OnTime используется для планирования выполнения процедуры через определенные интервалы времени.

Синтаксис

Приложение .OnTime Time, имя_процедуры Time указывает интервал времени, в котором должна выполняться процедура.

Имя_процедуры определяет имя процедуры.

Мы использовали метод Application.onTime для планирования макроса MsgProcedure.

Пожалуйста, введите код ниже

Option Explicit

Sub TimerMsg()

'Declaring Date variable

Dim AlertTime As Date

'Displaying message box at the start of the timer

MsgBox "The alarm will go off in 3 seconds!"

'Setting timer time for 3 seconds after the activation time

AlertTime = Now + TimeValue("00:00:03")

'Activating the timer and running the MsgProcedure at the end of the timer

Application.OnTime AlertTime, "MsgProcedure"

End Sub

Sub MsgProcedure()

'Sample procedure created for timer example

MsgBox "Three Seconds is up!"

End Sub

Если вам понравился этот блог, поделитесь им с друзьями на Facebook и Facebook.

Мы будем рады услышать от вас, дайте нам знать, как мы можем улучшить нашу работу и сделать ее лучше для вас. Напишите нам на [email protected]

Навигация по записям

как реализовать таймер для проверки тайм-аута кода

I have some code that runs on workbook open that uses a form to request that the user select the drive to which a shared directory is mapped.

This is because the workbook uses VBA code to retrieve and save data to a shared workbook located in this shared directory, but the local drive changes by user, so they need to select it.

The problem I’ve run into occurs when the user has mapped multiple shared directories to their computer and thus have multiple drives… ex: 1 directory is on drive G: and the other is on X:.

If they select the drive for the shared directory in which the workbook resides, there is no problem. However, if they accidentally choose the drive for the other shared directory, the code hangs.

I have a loop setup that checks to see they’ve chosen the correct drive… IE: If they chose A: (a non-existent drive in my example), then the code will note that they chose the incorrect drive and prompt them again.

However, instead of creating an error when another shared directory is chosen, the code just hangs.

In the below code, cell AD3 on sheet one contains true or false (gets set to false in the beginning of the sub). It gets set to true if they’ve chosen correct drive as Module6.PipelineRefresh will no longer cause an error (this sub attempts to open the workbook in the shared drive… and if the chosen drive is incorrect it obviously returns an error)

Codes is as below:

Do While Sheet1.Range("ad3") = False
       On Error Resume Next
           Call Module6.PipelineRefresh  '~~ I'm guessing the code hangs here.  Instead of returning an error immediately, as it would if they simply chose a non-existant drive, it appears to get stuck trying to open the workbook, even though it's not located in the shared directory they've selected.
       If Err.Number = 0 Then
           Sheet1.Range("ad3") = True
           Err.Clear
       Else
           MsgBox "Invalid Network Drive."
           DriverSelectForm.Show
           Err.Clear
       End If
Loop

If anyone knows how to implement a timer so I can shutdown the code after some amount of time, that’d be great.

Alternatively, if you know how to get around this error, that’d also be great!

EDIT as per comment:

This is the specific code in Module6.PipelineRefresh that hangs. The DriverSelectForm (shown above) amends the value in cell o1 to the chosen drive string (ie: X:)

Dim xlo As New Excel.Application
Dim xlw As New Excel.Workbook
Dim xlz As String
xlz = Sheet1.Range("o1").Value & "\Region Planning\Created Pipeline.xlsx"
Dim WS As Worksheet
Dim PT As PivotTable

Application.DisplayAlerts = False
Set xlw = xlo.Workbooks.Open(xlz)
Application.DisplayAlerts = True

Note: As stated above, if the user selects a non-existent directory, the above code returns an error immediately because it cannot open the file… if they have a shared directory mapped to the chosen drive (but it’s the wrong directory), the code will hang and does not appear to return an error.

Функция таймера

VBA — автоматизация Excel Автоматизация Excel

Функции таймера VBA возвращают количество секунд, прошедших с полуночи текущего дня (возвращается как тип данных Single).

Использование функции таймера VBA

Следующий код покажет вам, как использовать функцию таймера VBA, чтобы определить, сколько секунд прошло с полуночи на момент выполнения кода:

 Sub UsingTheVBATimerFunction ()

    Тусклые секунды, начиная с одиночного

    secondsSince = Таймер ()
    Отлаживать.Печать секунд

Конечный переводник 

Результат:

Используйте таймер VBA для получения фактического времени

Вы можете преобразовать секунды, возвращаемые функцией таймера, в формат чч: мм: сс, чтобы увидеть фактическое время, используя следующий код:

 Sub GettingTheActualTime ()

    Тусклые секунды, начиная с одиночного
    Dim cTime As Double
    Уменьшить фактическое время как вариант

    secondsSince = Таймер ()

    cTime = secondsSince / (86400)
    theActualTime = Format (cTime, «чч: мм: сс»)

    MsgBox "Время, прошедшее с полуночи в секундах:" & "" & секундыSince & vbNewLine & _
    "Фактическое время:" & "" & theActualTime

Конечный переводник 

Результат:

Время раздела кода VBA

Если вы хотите протестировать переписанный код или обсудить «более быстрые» методы в VBA, вы можете использовать встроенный таймер VBA.Установка переменной, равной таймеру в начале вашего кода, и вычитание этого значения из таймера в конце даст вам хорошую оценку того, сколько времени требуется для выполнения фрагмента кода.

На производительность, помимо прочего, могут влиять другие программы, работающие или пытающиеся запустить, пока ваш макрос активен.

Следующий пример был использован, чтобы увидеть, сколько времени потребуется, чтобы записать слово «тест» в ячейку A1 на Листе 1 полмиллиона раз. На моей машине это заняло 21 секунду.

 Sub BenchMark ()

Тусклый счет до тех пор, пока
Dim BenchMark как двойной

BenchMark = Таймер

'Начало кода для тестирования

Для Count = от 1 до 500000
    Sheet1.Cells (1, 1) = "тест"
Следующий счет

'Конец кода для тестирования

Таймер MsgBox - BenchMark

Конечный переводник 

Если ваш код работает медленно, попробуйте ускорить его, отключив обновление экрана.

excel — код VBA + таймер

Помимо неправильных строк кода, упомянутых в комментариях (особая благодарность @Mrig), в вашем коде отсутствуют некоторые проверки, чтобы убедиться, что все на месте для работы кода.Итак, вот код с правильными настройками:

  Опция Явная

Дополнительный макрос1 ()

Dim shp как форма
Dim ws как рабочий лист
Dim bolFound как Boolean

Application.ScreenUpdating = False

'Проверка наличия листа' Bt 1 '
bolFound = Ложь
Для каждого ws в ThisWorkbook.Worksheets
    Если ws.Name = "Bt 1", то bolFound = True
Следующий ws
Если bolFound = False, то
    MsgBox "Требуемый лист" Bt 1 "не найден." & Chr (10) & "Прерывание ..."
    Выйти из подводной лодки
Конец, если

С помощью ThisWorkbook.Worksheets ("Bt 1")
    'Копирование значения из X12 в W12
    .Диапазон ("W12"). Значение2 =. Диапазон ("X12"). Значение2
    'Проверка Z3 перед продолжением
    Если .Range ("Z3") = 0 Тогда
        MsgBox "Z3 равно 0." & Chr (10) & _
            "Прерывание ..."
        Выйти из подводной лодки
    Конец, если
    Если не IsNumeric (.Range ("Z3"). Value), то
        MsgBox «Z3 на листе 'Bt 1' не является датой / временем». & Chr (10) & _
            «Следовательно, секунда не может быть вычтена из Z3». & Chr (10) & _
            "Прерывание ..."
        Выйти из подводной лодки
    Конец, если
    .Range ("Z3"). Value =.Диапазон ("Z3"). Значение - TimeValue ("00:00:01")
    'Проверка наличия' TextBox 1 '
    bolFound = Ложь
    Для каждой шп в. Формы
        Если shp.Name = "TextBox 1", то bolFound = True
    Следующая shp
    Если bolFound = False, то
        MsgBox "Требуемая форма" TextBox 1 "не найдена." & Chr (10) & "Прерывание ..."
        Выйти из подводной лодки
    Конец, если
    Если .Range ("Z3"). Value <= TimeValue ("00:00:10"), то
        .Shapes ("TextBox 1"). Fill.ForeColor.RGB = RGB (255, 0, 0)
    Еще
        .Shapes ("Текстовое поле 1").Fill.ForeColor.RGB = RGB (255, 255, 255)
    Конец, если
Конец с

Application.OnTime Now + TimeValue ("00:00:01"), "nexttick"
Application.ScreenUpdating = True

Конец подписки
  

Даже если код не выполняется должным образом, вы должны получить достаточную обратную связь, чтобы внести необходимые исправления (для запуска кода).

Дайте мне знать, если у вас возникнут дополнительные вопросы.

Таймер Excel VBA выполняет обратный вызов только один раз [решено]

Следующий код был разработан в Office97 и работал в последующих версиях Windows и Office.Однако использование его в Office2013 - это слишком далеко. Я сократил пример, в котором обратный вызов обычно обменивается данными через последовательный порт. Теперь я просто пытаюсь увеличить содержимое ячейки, но проблема остается той же: обратный вызов вызывается один раз, тогда как в старой ситуации он вызывался повторно, как и предполагалось.
Я заметил, что теперь он работает на 64-битной версии, и скорректировал объявления для этого. Электронная таблица содержит две кнопки, которые вызывают подпрограммы «actionStart» и «actionStop».
Вот код:

  Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) Пока

Частный lngTimerId As LongPtr

Функция TickHandler (ByVal hwnd &, ByVal lngMsg &, ByVal lngTimerId &, ByVal lngTime &)
    Ячейки (40, 7) .Значение = Ячейки (40, 7).Значение + 2
Конечная функция

Sub Timer_Initialize (необязательный vInterval как вариант)
Dim lngInterval As Long
    lngInterval = CLng (vInterval)
    Если lngInterval <100, то lngInterval = 100
    Если lngTimerId = 0 Тогда
         lngTimerId = SetTimer (0, 0, lngInterval, AddressOf TickHandler)
    Конец, если
    Если lngTimerId = 0 Тогда
        MsgBox "Невозможно инициализировать новый таймер!"
    Конец, если
Конец подписки

Sub Timer_Terminate ()
    Если lngTimerId <> 0 Тогда
        Вызов KillTimer (0, lngTimerId)
        lngTimerId = 0
    Конец, если
Конец подписки

Sub actionStart ()
    Вызов Timer_Initialize (100)
Конец подписки

Sub actionStop ()
    Вызов Timer_Terminate ()
Конец подписки
  

Думаю, я должен увидеть, что ячейка G40 перейдет в 0...2 ... 4 ... 6 ... 8 каждую секунду. Так и было в старых версиях! Для меня самое удивительное то, что он работает, но только один раз. Помощь?

С уважением, Саймон

Использование таймера в макросах MS Office VBA

Для тех из нас, кто глубоко увлечен VB.NET, возвращение к VB6 может оказаться запутанным. Использование таймера в VB6 похоже на это. В то же время добавление синхронизированных процессов в ваш код не очевидно для новых пользователей макросов VBA.

Таймеры для новичков

Кодирование макроса Word VBA для автоматического определения времени теста, написанного в Word, является типичной причиной использования таймера.Другая распространенная причина - увидеть, сколько времени занимают разные части вашего кода, чтобы вы могли работать над оптимизацией медленных участков. Иногда вам может потребоваться посмотреть, происходит ли что-нибудь в приложении, когда кажется, что компьютер просто сидит без дела, что может быть проблемой безопасности. Таймеры могут это сделать.

Запуск таймера

Вы запускаете таймер, кодируя оператор OnTime. Этот оператор реализован в Word и Excel, но имеет разный синтаксис в зависимости от того, какой из них вы используете.Синтаксис Word:

выражение.OnTime (Когда, Имя, Допуск)

Синтаксис Excel выглядит так:

выражение.OnTime (EarliestTime, Procedure, LatestTime, Schedule)

Оба имеют общий первый и второй параметр. Второй параметр - это имя другого макроса, который запускается при достижении времени в первом параметре. Фактически, кодирование этого оператора похоже на создание подпрограммы события в VB6 или VB.NET условия. Событие приближается к времени в первом параметре. Подпрограмма события - второй параметр.

Это отличается от того, как он кодируется в VB6 или VB.NET. Во-первых, макрос, указанный во втором параметре, может быть в любом доступном коде. В документе Word Microsoft рекомендует помещать его в шаблон документа Normal. Если вы поместите его в другой модуль, Microsoft рекомендует использовать полный путь: Project.Module.Macro.

Выражение обычно является объектом Application.В документации Word и Excel указано, что третий параметр может отменить выполнение макроса события в случае, если диалоговое окно или какой-либо другой процесс препятствует его запуску в течение определенного времени. В Excel вы можете запланировать новое время, если это произойдет.

Закодируйте макрос временного события

Этот код в Word предназначен для администратора, который хочет отобразить уведомление о том, что время тестирования истекло, и распечатать результат теста.

Открытая подпрограмма TestOnTime ()
Отладка.Распечатать "Тревога сработает через 10 секунд!"
Debug.Print («До OnTime:» и сейчас)
alertTime = Now + TimeValue («00:00:10»)
Application.OnTime alertTime, «EventMacro»
Debug.Print («После OnTime:» и сейчас)
End Sub
Sub EventMacro ()
Debug.Print («Выполнение макроса события:» и сейчас)
End Sub

Это приводит к следующему содержимому в непосредственном окне:

Тревога сработает через 10 секунд!
До включения: 25.12.2000 19:41:23
После включения: 25.12.2000 19:41:23
Макрос выполнения события: 27.02.2010 19:41:33

Вариант для других офисных приложений

Другие приложения Office не поддерживают OnTime.Для них у вас есть несколько вариантов. Во-первых, вы можете использовать функцию таймера, которая просто возвращает количество секунд, прошедших с полуночи на вашем ПК, и выполняет ваши собственные вычисления, или вы можете использовать вызовы Windows API. Использование вызовов Windows API имеет то преимущество, что они более точны, чем таймер. Вот процедура, предложенная Microsoft, которая помогает:

Частная функция объявления getFrequency Lib "kernel32" _
Псевдоним "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Псевдоним "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Sub TestTimeAPIC53 Dim dTime As Double
dTime = MicroTimer
Dim StartTime As Single
StartTime = Timer
For i = 1 to 10000000
Dim j As Double
j = Sqr (i)
Next
Debug.Печать («Время микротаймера было:» & MicroTimer - dTime)
End Sub

Функция MicroTimer () As Double
'
' Возвращает секунды.
'
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0
'Получить частоту.
Если cyFrequency = 0 Тогда getFrequency cyFrequency
'Получить тики.
getTickCount cyTicks1
'Секунды
Если cyFrequency Тогда MicroTimer = cyTicks1 / cyFrequency
Конечная функция

Статья 35 - VBA - Функция таймера и преодоление полуночных ограничений функции таймера | `E для Excel

Статья 35 - VBA - Функция таймера и преодоление полуночного ограничения функции таймера

Базовый и классический и самый популярный режим для синхронизации кода достигается с помощью функции таймера, которая изначально предоставляется VBA.Он возвращает Single , представляющий количество секунд, прошедших с полуночи. Следовательно, ваш код будет выглядеть следующим образом, если вы хотите измерить время, и он дает результат в секундах .

 Dim StartTime как одиночный, TimeElapsed как одиночный
StartTime = Таймер
<--- Ваш код следует --->
TimeElapsed = Таймер - StartTime 

Насколько точна функция таймера

Возвращает результат в виде переменной типа данных Single.Переменная с одним типом данных может содержать не более 8 цифр, включая десятичную дробь. Следовательно, если вы посмотрите на результат функции таймера в 15.49, его результат будет 56964.29. Его результат в 00:50 будет 3006,773, а его результат в 23:51 будет 85850,41. Следовательно, он имеет минимальную точность до двух десятичных знаков, чего достаточно для большинства наших задач.

Точность тика системных часов составляет 1/64 секунды или 1/256 секунды. По этому поводу существуют различные мнения, и нет правильной документации Microsoft по этому поводу, которая действовала бы как достоверная информация.Такая точность должна подходить для большинства наших работ.

Преодолеть проблему MIDNIGHT функции ТАЙМЕРА

Так как таймер показывает количество секунд, прошедших с полуночи, следовательно, если ваш код все еще работает, когда наступит следующая полночь, он не даст правильных результатов. Следовательно, если вы запустили свой код в 23:54, функция таймера выдаст вам результат 57255,91. В полночь функция таймера сбрасывается до 0, поскольку она считает только количество секунд после полуночи.Если ваша работа заканчивается в 00:01, это означает, что новое значение таймера равно 60, и, следовательно, ваше время будет отрицательным, что, очевидно, не так.

Чтобы решить эту проблему, нам нужно также проверить часть даты и изменить код таймера, как показано ниже -

 Dim StartTime как одиночный, TimeElapsed как одиночный
Затенять дату начала как дату
StartDate = Дата
StartTime = Таймер
'<--- Ваш код следует --->
TimeElapsed = 86400 * (Дата - Дата начала) + Таймер - Время начала 

Функция таймера

Excel VBA - Учебное пособие и пример

Excel VBA Timer Function: Функция Timer в VBA возвращает тип данных Single, оценивая количество секунд, прошедших с полуночи текущего дня.

Синтаксис

Параметр

NA

Возврат

Эта функция возвращает тип данных Single после оценки
количество секунд, прошедших с полуночи текущего дня.

Пример 1

Sub TimerFunction_Example1 ()
'Он вернет количество секунд с полуночи
Dim secs_val как одиночный
secs_val = Таймер ()
'Переменная secs_val вернет 83638.67188
Ячейки (1, 1) .Value = secs_val
Конец подписки

Sub TimerFunction_Example1 ()

'Он вернет количество секунд с полуночи

Dim secs_val As Single

secs_val = Timer ()

' Переменная secs_val вернет 83638.67188

.Value = secs_val

End Sub

Выход

83638.67

Пример 2

Sub TimerFunction_Example2 ()
'Он вернет количество секунд с полуночи
Dim secs_val1 как Single, secs_val2 как Single
secs_val1 = Таймер ()
MsgBox (secs_val1 & "секунды")
'возвращение следующего количества секунд после полуночи
secs_val2 = Таймер ()
MsgBox (secs_val2 & "секунды")
'Сохраняя разницу
MsgBox ("Время, затраченное на выполнение кода:" & vbNewLine & secs_val1 - secs_val2 & "секунды")
Конец подписки

Sub TimerFunction_Example2 ()

'Возвращает количество секунд с полуночи

Dim secs_val1 As Single, secs_val2 As Single

secs_val1 = Timer ()

"MsgBox (9 secs_val1) возврат следующего количества секунд после полуночи

secs_val2 = Timer ()

MsgBox (secs_val2 & "секунды")

'восстановление разницы

MsgBox ("Время, необходимое для выполнения кода:" & vbNewLine & secs_val1 & secs_val1 & secs_val1 - secs_val «секунды»)

End Sub

Выход

VBA Macros - Timing

Timing

Это можно сделать тремя способами: VBA.Таймер, GetTickCount API или timeGetTime API.

VBA.Timer

Возвращает количество секунд, прошедших с полуночи, с использованием значения с плавающей запятой одинарной точности.
Это не многопоточный элемент управления, поэтому он не может сработать точно в нужное время.
Задержки могут быть вызваны другими приложениями или системными процессами.

 Public starttime As Single 
Public timeelapsed As Single

Public Sub RunCode ()
Dim l As Long
Dim a As Long
Для l = 1 До 800000000
a = a + 1
Next
End Sub

Public Sub Timer1 ()
время начала = VBA.Таймер
Call RunCode
timeelapsed = VBA.Timer - starttime
'Call MsgBox (timeelapsed & "секунды")
Call MsgBox (Format (timeelapsed / 60, "## 0. ###") & "minutes")
End Sub

GetTickCount API

Возвращает количество миллисекунд, прошедших с момента запуска Windows.
Это будет работать в течение 49 дней перед сбросом на ноль.

 Public Declare Function GetTickCount Lib "kernel32.dll" () As Long 

Public Sub Timer2 ()
starttime = GetTickCount ()
Call RunCode
timeelapsed = (GetTickCount () - starttime)
Call MsgBox (timeelapsed / 1000 & " секунд ")
Call MsgBox (timeelapsed / 60000 &" minutes ")
Call MsgBox (timeelapsed / 3600000 &" hours ")
End Sub

timeGetTime API

Возвращает количество миллисекунд, прошедших с момента появления Windows был начат.

 Public Declare Function timeGetTime Lib "winmm.dll" () As Long 

Public Sub Timer3 ()
starttime = timeGetTime ()
Call RunCode
timeelapsed = (timeGetTime () - starttime)
Call MsgBox (timeelapsed & "seconds" )
End Sub

Поиск узких мест

msdn.microsoft.com/en-us/library/aa730921


© 2021 Better Solutions Limited. Все права защищены. © 2021 Better Solutions Limited TopPrevNext.

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *