Реализация простого секундомера в ячейке рабочего листа с помощью кода VBA Excel. Примеры с использованием метода Application.OnTime.
Секундомер в ячейке Excel
Точность работы секундомера, реализованного средствами VBA Excel, оставляет желать лучшего, но для простых задач и в целях изучения вполне подойдет.
Внешний вид простого секундомера в ячейке рабочего листа в состоянии «включен»:
Для включения и выключения секундомера используется одна кнопка из коллекции «Элементы ActiveX», у которой в зависимости от состояния таймера меняется название (Caption).
Код секундомера располагается в модуле листа (в примерах – «Лист4»), результат выводится в ячейку «B2».
Код секундомера 1
На рабочий лист «Лист4» добавлена кнопка CommandButton1 из коллекции «Элементы ActiveX». Ее видимое наименование (Caption) вручную изменено на «Старт». При первом клике наименование кнопки программным способом изменяется на «Стоп», ячейке «B2» присваивается пустая строка и запускается секундомер. При повторном клике секундомер останавливается, а наименование кнопки меняется на «Старт».
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 |
Option Explicit 'Объявление общей переменной для всех процедур Dim start As Boolean Private Sub CommandButton1_Click() If CommandButton1.Caption = "Старт" Then start = True 'Форматирование ячейки "B2" и присвоение ей пустой строки 'Форматирование можно сделать вручную, а оставить только 'присвоение пустой строки: Range ("B2") = "" With Range("B2") .NumberFormat = "h:mm:ss;@" .Borders.LineStyle = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Value = "" End With 'Запуск процедуры секундомера Call Stopwatch 'Меняется наименование кнопки CommandButton1.Caption = "Стоп" Else start = False 'Меняется наименование кнопки CommandButton1.Caption = "Старт" End If End Sub Private Sub Stopwatch() If start = True Then 'Это условие необходимо, чтобы начать отсчет с нуля If Range("B2") <> "" Then Range("B2") = Range("B2") + TimeValue("00:00:01") Else Range("B2") = 0 End If 'Процедура приостанавливается на 1 секунду и запускает саму себя Application.OnTime Now + TimeValue("00:00:01"), "Лист4.Stopwatch" Else Exit Sub End If End Sub |
Код секундомера 2
В этом примере используются две процедуры VBA Excel с методом Application.OnTime, которые по очереди запускают друг друга. Этот код приведен исключительно для ознакомления, что так тоже можно.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
Option Explicit Dim start As Boolean Private Sub CommandButton1_Click() If CommandButton1.Caption = "Старт" Then start = True With Range("B2") .NumberFormat = "h:mm:ss;@" .Borders.LineStyle = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Value = "" End With Call Stopwatch1 CommandButton1.Caption = "Стоп" Else start = False CommandButton1.Caption = "Старт" End If End Sub Private Sub Stopwatch1() If start = True Then If Range("B2") <> "" Then Range("B2") = Range("B2") + TimeValue("00:00:01") Else Range("B2") = 0 End If 'Процедура приостанавливается на 1 секунду и запускает процедуру Stopwatch2 Application.OnTime Now + TimeValue("00:00:01"), "Лист4.Stopwatch2" Else Exit Sub End If End Sub Private Sub Stopwatch2() If start = True Then Range("B2") = Range("B2") + TimeValue("00:00:01") 'Процедура приостанавливается на 1 секунду и запускает процедуру Stopwatch1 Application.OnTime Now + TimeValue("00:00:01"), "Лист4.Stopwatch1" Else Exit Sub End If End Sub |
Как сделать, чтобы работа секундомера не прекращалась при вводе данных в другие ячейки этого листа? Как сделать сброс отдельной клавишей? Всё относится к первому варианту.
Искал в интернете примеры реализации секундомера и случайно попал на ваш сайт. Был приятно удивлен!!!
Я приступаю к изучению VBA с нуля, жизнь заставляет, мне 58 лет. Если у вас есть такая возможность, помогите пожалуйста написать код для секундомера с возможностью нескольких остановок и последующих запусков во время некоторого эксперимента, который длится к примеру 100 секунд. Время секундомера или таймера будет в дальнейшем управлять неким виртуальным физическим процессом. По окончании эксперимента секундомер должен остановиться на значении 100 секунд, суммируя все активные периоды в течении эксперимента, в течение пауз у экспериментатора есть возможность осмыслить суть происходящего. Двойным кликом на кнопке Старт/Стоп хотелось бы сбрасывать значение в ноль, чтобы можно было начать некий эксперимент заново. Эксперимент проводится на математической модели виртуального учебного лабораторного стенда, реализованного штатными средствами Excel (моделируется некий физический процесс). Секундомер или таймер должен отсчитывать также и милисекунды (как я понимаю Timer использует системное время компьютера).
Нашел такой код:
В ячейку А4 вводим формулу =A3-A2
Время в ячейке A4 начинает нарастать сразу после клика по кнопке и останавливается после следующего клика. Следующий клик по кнопке обнуляет значение и запускает счет заново. Это не совсем то, что требуется, но хоть что-то.
Заранее спасибо, очень рассчитываю на вашу помощь.
Установил Ваш секундомер. Но при защите листа кнопка «Старт» нажимается, а секундомер не включается. Со всех нужных ячеек ( показания секундомера; ячейку кнопки «Старт»; с самой кнопки «Старт» — через «Разработчик», «режим конструктор», «свойства») тоже снял защиту. Помогите пожалуйста, как запустить секундомер при защите листа.