Форумы HiProg.com - MS ACCESS, VBA, VB

ник: Силblч
странное происходит
реализовал, типа таймер, на форме экселя

если запускаем форму, которая запускает другую форму с таймером, через функцию - таймер работает
если запускаем форму, которая запускает другую форму с таймером, через пункт меню - таймер не работает


гыгынуха какая то, а не Excel

Option Explicit Public isCancel% Public ParentFormName$ Dim rs As ADODB.Recordset Dim timer_enabled As Boolean Dim timer_interval As Double Dim phWnd& Private Sub btnCancel_Click()     If Err = 0 Then         If MsgBox("Прерывание может занять несколько минут" & vbNewLine & _                   "Вы действительно хотите прервать выполнение запроса к серверу?" _                   , vbYesNo, "Подтвердите") = vbNo Then Exit Sub     End If     isCancel = 1     timer_Stop     Me.Hide     DoEvents End Sub Private Sub UserForm_Activate() On Error GoTo err123     Dim ff As Object     isCancel = 0     If Len(nz(ParentFormName, "")) = 0 Then         MsgBox "Неверно переданы параметры" & vbCrLf & iDevelop         GoTo errTerm     End If     For Each ff In VBA.Global.UserForms         If ff.name = ParentFormName Then Exit For     Next     If ff Is Nothing Then GoTo errTerm     Set rs = ff.oTray     If rs.State = adStateClosed Then GoTo errTerm     Me.txtTimeOf = Format(Abs(Time()), "Long Time")     phWnd = initBar(20)     Call timer_Start(TimeValue("00:00:01"))     Exit Sub err123:     MsgBox Error & vbCrLf & iDevelop errTerm:     Call timer_Stop: isCancel = 0: Unload Me     Exit Sub End Sub Private Sub UserForm_Initialize() 'хз End Sub Public Sub Timer_OnTimer()     Call Timer     If timer_enabled Then Call timer_Start End Sub Public Sub Timer() On Error Resume Next Dim tt Static i% tt = Format(Abs(Time()), "Long Time") Me.txtTimeOf = tt i = i + 1: updateBar i If i > 20 Then clearBar phWnd: initBar 20: i = 1 If conn.State = 0 Then     MsgBox "Сервер прервал сессию"     Call btnCancel_Click     Exit Sub End If Select Case rs.State Case adStateClosed '0 Indicates that the object is closed.     Me.capInfo.caption = "Закрыт:"     Me.capInfo.ForeColor = RGB(255, 0, 0)     MsgBox "Запрос закрыт со стороны сервера " & iDevelop     Call timer_Stop: isCancel = 0: Me.Hide     Exit Sub Case adStateOpen '1 Indicates that the object is open.     Me.capInfo.caption = "Выполнен:"     Call timer_Stop: isCancel = 0: Me.Hide     Exit Sub Case adStateConnecting '2 Indicates that the object is connecting.     Me.capInfo.caption = "Подключен:" Case adStateExecuting '4 Indicates that the object is executing a command.     Me.capInfo.caption = "Выполняется:" Case adStateFetching '8 Indicates that the rows of the object are being retrieved.     Me.capInfo.caption = "Выгружается:" End Select If Err = 0 Then Exit Sub err123:     MsgBox Error & vbCrLf & iDevelop, , "Timer"     Call btnCancel_Click Exit Sub End Sub Sub timer_Start(Optional ByVal interval As Double)     If interval > 0 Then timer_interval = interval     timer_enabled = True     If timer_interval > 0 Then Application.OnTime (Now + timer_interval), "RunOnTimer" 'процедура в модуле. запускает Timer_OnTimer End Sub Sub timer_Stop()     timer_enabled = False     Application.EnableCancelKey = 0 'отключаем прерывание     clearBar phWnd End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)     If CloseMode = vbFormControlMenu Then         MsgBox "Закрытие этой формы возможно только при нажатии на кнопку 'Прервать'", , iMsgErr         Cancel = True     End If End Sub Private Sub UserForm_Terminate()     isCancel = 0     clearBar phWnd     SetStatus End Sub