Реализация простого секундомера в ячейке рабочего листа с помощью кода 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 |
Как сделать, чтобы работа секундомера не прекращалась при вводе данных в другие ячейки этого листа? Как сделать сброс отдельной клавишей? Всё относится к первому варианту.