Некорректно работает процедура обновления

[Андрэич]

Здравствуйте! Уважаемые гуру, прошу вашей помощи.

Наваял нечто вроде прогресс-бара. Каждая строка - это одна или неск процедур (см. скрин).

Всё работает, кроме одного: не получается отображать в соответствующих полях на форме корректное время выполнения каждой из процедур. Выводит нули (проскакивает иногда, редко, - что-то типа 0,1 сек).

Ставлю точку останова, иду по шагам - и когда переключаюсь из редактора в форму, всё замечательно: время напротив каждой строки (т.е. процедуры) на форме отображается, итоговое время (внизу справа на скрине) выполнения тоже.
(Единственно что: округляется и всегда в меньшую сторону, например: 15,122 сек и 15, 871 в итоговом поле остаются пятнадцатью: то есть, 15 без десятичных знаков.
Уважаемые профи, подскажите пожалуйста, что у меня не так, давно уже бьюсь...

- DoEvents не помогает, куда только не втыкал.
- Не помогает также и .requery (и остальные .re…).
- Источник данных формы – пользовательская системная таблица (с единственной записью), в полях которой сохраняются настройки; указ поля не связаны с полями таблицы.
- Файл выложить не могу – очень объёмный…

[Андрэич]

Вот листинг (извините, не разобрался пока с тэгами...):

Public Sub ProgressBar(ByRef Proc As String)
'Аргумент - имя выполняемой процедуры,
'с которой в случае сбоя выполнение кода будете возобновлено

Dim N As Byte        'Количество итераций. N(umber)
Dim Prgrs As Byte    'Счётчик. Pr(o)gr(e)ss
Dim F As Form        'Форма Обновление классификаторов. F(orm)
Dim Sq As Control    'Квадратики прогресса выполнения. Sq(uare)
Dim Lb As Control    'Главная надпись. L(a)b(le)
Dim Rd As Control    'Надпись Готово. R(ea)d(y)
Dim Tm As Control    'Поле Время выполнения. T(i)m(e)
Dim tmStart          'Таймер начало
Static TmS           'Общее время выполнения. TimeS(ummary)
Dim ins As String    'Запрос на обновление значений счётчика и названия процедуры. Ins(ert)
Dim ins1 As String   'Запрос на обновление значений счётчика и названия процедуры. Ins(ert)

'Ссылка на форму вызова
Set F = Forms!frmClsssUpdating
'Строка запроса
ins = "UPDATE sysOptions_Update SET Progress = "
'ins1 = "UPDATE sysOptions_Update SET ProgressProc = "

'Счётчик процедуры = значение соотв поля формы (таблицы)
Prgrs = CByte(Trim(F!txtPrgrs))
N = 23       'колич итераций вводится вручную
'Получаем начальное время
tmStart = timeGetTime()
Select Case Prgrs  'В зависимости от шага выполнения обновления
    Case 1 To (N - 2)  'Вход в процедуру со второго до предпоследнего
        'Надпись Готово
        Set Rd = F("Rd" & Prgrs)
        Rd.Visible = True
        'Квадратик
        Set Sq = F("Sq" & Prgrs)
        Sq.Visible = True
        'Основная надпись серая
        Set Lb = F("Lb" & Prgrs)
        Lb.ForeColor = RGB(173, 173, 173)
'        DoEvents
        'Время выполнения
        Set Tm = F("Tm" & Prgrs)
        Tm = ((timeGetTime() - tmStart) \ 1000) & " сек"
        DoEvents
        F.Repaint
        Tm.Visible = True
        'Общее время выполнения
        TmS = TmS + CLng(Val(Tm))
        F("TmSum") = TmS
        F.Repaint
        'Наращиваем значение счётчика
        Prgrs = Prgrs + 1
        'Увеличиваем значение в таблице
        CurrentDb.Execute ins & Prgrs
'        CurrentDb.Execute ins1 & Proc
        'Основная строка
        Set Lb = F("Lb" & Prgrs)
        Lb.Visible = True
    Case 0              'Если это первый вход в процедуру
        'Наращиваем значение счётчика
        Prgrs = 1
        'Увеличиваем значение в таблице
        CurrentDb.Execute ins & Prgrs
'        CurrentDb.Execute ins1 & Proc
        'Квадратик
        Set Sq = F("Sq" & Prgrs)
        Sq.Visible = True
        'Основная строка
        Set Lb = F("Lb" & Prgrs)
        Lb.Visible = True

    Case N - 1            'Если это предпоследний вход в процедуру
        'квадратик
        Set Sq = F("Sq" & Prgrs)
        Sq.Visible = True
        'Надпись Готово
        Set Rd = F("Rd" & Prgrs)
        Rd.Visible = True
        'Основная надпись серая
        Set Lb = F("Lb" & Prgrs)
        Lb.ForeColor = RGB(173, 173, 173)
'        DoEvents
        'Время выполнения
        Set Tm = F("Tm" & Prgrs)
        Tm = ((timeGetTime() - tmStart) \ 1000) & " сек"
        Tm.Visible = True
        'Общее время выполнения
'        F("TmSum") = TmS + Tm
        'Последний синий квадратик
        Set Sq = F("Sq" & Prgrs)
'        Sq.BackColor = RGB(244, 4, 40)
        Sq.Visible = True

        'Счётчик = N
        Prgrs = Prgrs + 1
        'Основная строка
        Set Lb = F("Lb" & Prgrs)
        Lb.Visible = True
        CurrentDb.Execute ins & Prgrs
'        CurrentDb.Execute ins1 & Proc
    Case N                   'Если это последний вход в процедуру
        'Надпись Готово
        Set Rd = F("Rd" & Prgrs)
        Rd.Visible = True
        'Основная надпись серая
        Set Lb = F("Lb" & Prgrs)
        Lb.ForeColor = RGB(173, 173, 173)
'        DoEvents
        'Время выполнения
        Set Tm = F("Tm" & Prgrs)
        Tm = ((timeGetTime() - tmStart) \ 1000 & " сек")
        Tm.Visible = True
        'Время общее видима
        F("Tm" & Prgrs).Visible = True
         'Последний квадратик - красный
        Set Sq = F("Sq" & Prgrs)
        Sq.BackColor = RGB(244, 4, 40)
        Sq.Visible = True

       'Сбрасываем значение счётчика
        CurrentDb.Execute ins & 0
'        CurrentDb.Execute ins1 & ""
End Select
Set F = Nothing: Set Sq = Nothing: Set Lb = Nothing: Set Rd = Nothing: Set Tm = Nothing: Set p = Nothing
End Sub

[Step_UA]

Откуда же взяться долям секунды, если вы производите целочисленное деление ('\' вместо '/') при вычисление промежутка времени:

Tm = ((timeGetTime() - tmStart) / 1000) & " сек"

[Андрэич]

Согласен, спасибо.
Но главный сабж, собственно, не в палочке...

[Step_UA]

так от сюда ноги ростут ... если у вас происходит одно обновление менее чем за секунду (в пошаговом больше), то при целочисленном делении получается 0. Затем это значение (из поля - целое число секунд) используется для вычисления общего времени ...

[Андрэич]

Сообщение от Step_UA

так от сюда ноги ростут ... если у вас происходит одно обновление менее чем за секунду (в пошаговом больше), то при целочисленном делении получается 0. Затем это значение (из поля - целое число секунд) используется для вычисления общего времени ...

Я, конечно, попробовал...
Всё по-прежнему (там, кстати, некоторые подпроцедуры выполняются по минуте)

[Step_UA]

Собственно где в этом участке кода, замеряющего промежуток времени - вызов какой-либо процедуры? Вы замеряете время потраченное на присвоение ссылок на объекты для 4 переменных ...

tmStart = timeGetTime()
Select Case Prgrs  'В зависимости от шага выполнения обновления
    Case 1 To (N - 2)  'Вход в процедуру со второго до предпоследнего
        'Надпись Готово
        Set Rd = F("Rd" & Prgrs)
        Rd.Visible = True
        'Квадратик
        Set Sq = F("Sq" & Prgrs)
        Sq.Visible = True
        'Основная надпись серая
        Set Lb = F("Lb" & Prgrs)
        Lb.ForeColor = RGB(173, 173, 173)
'        DoEvents
        'Время выполнения
        Set Tm = F("Tm" & Prgrs)
        Tm = ((timeGetTime() - tmStart) \ 1000) & " сек"

[Андрэич]

Сообщение от Step_UA

Собственно где в этом участке кода, замеряющего промежуток времени - вызов какой-либо процедуры? Вы замеряете время потраченное на присвоение ссылок на объекты для 4 переменных ...

tmStart = timeGetTime()
Select Case Prgrs  'В зависимости от шага выполнения обновления
    Case 1 To (N - 2)  'Вход в процедуру со второго до предпоследнего
        'Надпись Готово
        Set Rd = F("Rd" & Prgrs)
        Rd.Visible = True
        'Квадратик
        Set Sq = F("Sq" & Prgrs)
        Sq.Visible = True
        'Основная надпись серая
        Set Lb = F("Lb" & Prgrs)
        Lb.ForeColor = RGB(173, 173, 173)
'        DoEvents
        'Время выполнения
        Set Tm = F("Tm" & Prgrs)
        Tm = ((timeGetTime() - tmStart) \ 1000) & " сек"

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

Да, действительно, из этой процедуры другие не вызываются (я её так назвал для наглядности). А алгоритм такой. Есть довольно объемная основная процедура обновления справочников, со множеством вложенных подпроцедур. Вызов же этой по сути функции происходит между этими подпроцедурами. Входящий параметр - имя след процедуры. Схематично так:

Sub Основная ()

ProgressBar ("Proc 1")
Proc 1
Proc 2
ProgressBar (Proc 3)
Proc 3
...
Еnd Sub

Что делает эта функция (буду теперь называть её так). Она сохраняет в спец таблице (а также на связ с ней форме - видно на скрине) номер её вызова и имя след процедуры, переданного ей в кач параметра. По задумке, в случае сбоя обновления, при след его запуске - оно должно начаться именно с места последнего вынужденного останова.

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

[Step_UA]

Sub Основная ()

ProgressBar ("Proc 1")
Proc 1
Proc 2
ProgressBar (Proc 3)
Proc 3
...
Еnd Sub

вот с этого нужно было начинать ))

Public Sub ProgressBar(ByRef Proc As String)
...
Static tmStart          'Таймер начало
...
' tmStart = timeGetTime() - убрать
...
End Select
tmStart = timeGetTime()
...
End Sub

[Андрэич]

Step_UA, вы монстр! У меня слов нет...

Товарищи модераторы, а как мне можно поставить ответившему прогеру реально заслуженные +50 ???