如何在以下代码VBA中执行暂停

问题描述

所以我有两个活动的计时器，其想法是当第二个活动的计时器启动时，第一个活动的计时器冻结，直到第二个活动结束。乍一看，用户窗体显示第一个活动计时器冻结了，但是以某种方式它继续在“后台”运行，当我结束第二个活动时，第一个活动计时器显示了已经过去的整个时间。

这是我衡量活动的模块：

Option Explicit

Public TimerActive As Boolean
Public FirstLoginTime As Date
Public CurrentActivityTime As Date
Public CurrentActivityTime1 As Date
Public PreviousLoginHours As Date


'To update Activity and Other hours on all the cards available on Activity Tracker

Sub Timer()
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    If TimerActive Then
        
        Dim TotalTime,ActivityTime,ActivityTime1
        
        TotalTime = Format(((Now() - FirstLoginTime) + PreviousLoginHours),"HH:MM:SS")
        
        If CurrentActivityTime > 0 Then
            
            ActivityTime = Format(((Now() - CurrentActivityTime)),"HH:MM:SS")
            ActivityTracker.CurrentActivityHours.Caption = ActivityTime
        End If
        
        If CurrentActivityTime1 > 0 Then
            
            ActivityTime1 = Format(((Now() - CurrentActivityTime1)),"HH:MM:SS")
            ActivityTime = Format(((Now() - CurrentActivityTime) - (Now() - CurrentActivityTime1)),"HH:MM:SS")
            ActivityTracker.CurrentActivityHours1.Caption = ActivityTime1
            ActivityTracker.CurrentActivityHours.Caption = ActivityTime
        
        
        End If
        
        Application.OnTime Now() + TimeValue("00:00:01"),"Timer"
        ActivityTracker.WorkingHours.Caption = TotalTime
        
        
    End If
        
        
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Exit Sub
    
ErrorHandler:
    
  MsgBox Err.Description,vbCritical,"Error"
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
    
End Sub 

这是我的开始按钮：

Private Sub cmdStart_Click()
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Me.txtDate = TodayDate()                                                'Date user defined function
    
    'On Error GoTo ErrorHandler
 
 If Me.lstActivityCode.Value = "Break" Then                                 'If Task is Break then no validation requried
    
    CurrentActivityTime = Now()
    Call Add_StartEntry(Me.lstActivityCode.Value,True,CurrentActivityTime) 'Checked
    Call Lock_UserInput
    
 
 ElseIf Validation = True And Me.lstActivityCode.Value <> "Break" Then      'If task is not break then validation required.
    
    CurrentActivityTime = Now()
    Call Add_StartEntry(Me.lstActivityCode.Value,CurrentActivityTime)
    Call Lock_UserInput
    
              
 Else
 
    Exit Sub
    
 End If
End Sub

我还有第二个活动的开始按钮，代码与第一个活动相同。

解决方法

非常感谢托米斯拉夫的澄清。计时器将始终从午夜返回当前秒数。我使用Now函数而不是Timer编写了此代码，但是它应该提供与您期望的结果相同的结果。我想您可能正在寻找类似的东西。

Option Explicit
Dim Activity_1_Timer As Double
Dim MyTimer_1 As Double
Dim Activity_1_Running As Boolean

Dim Activity_2_Timer As Double
Dim MyTimer_2 As Double
Dim Activity_2_Running As Boolean

Dim TimerDiff_1 As Double
Dim TimerDiff_2 As Double

Private Sub Btn_Activity_1_Timestamp_Click()
    If Activity_1_Running = True Then
        TimerDiff_1 = MyTimer_1 - Now
        If Activity_2_Running = False Then
            Activity_1_Timer = Activity_1_Timer + TimerDiff_1
        Else
            TimerDiff_2 = MyTimer_2 - Now
            Activity_1_Timer = Activity_1_Timer + TimerDiff_1 - TimerDiff_2
        End If
    End If
    MyTimer_1 = Now
    Debug.Print "Act 1: " & Format(Activity_1_Timer,"hh:mm:ss")
    Activity_1_Running = True
    Activity_2_Running = False
End Sub

Private Sub Btn_Activity_2_Timestamp_Click()
    If Activity_2_Running = True Then
        TimerDiff_2 = MyTimer_2 - Now
        If Activity_1_Running = False Then
            Activity_2_Timer = Activity_2_Timer + TimerDiff_2
        Else
            TimerDiff_1 = MyTimer_1 - Now
            Activity_2_Timer = Activity_2_Timer + TimerDiff_2 - TimerDiff_1
        End If
    End If
    MyTimer_2 = Now
    Debug.Print "Act 2: " & Format(Activity_2_Timer,"hh:mm:ss")
    Activity_2_Running = True
    Activity_1_Running = False
End Sub

Private Sub Btn_Reset_Click()
    Activity_1_Timer = 0
    Activity_2_Timer = 0
    
    MyTimer_1 = 0
    MyTimer_2 = 0
    
    Activity_1_Running = False
    Activity_2_Running = False
    
    Debug.Print "Act 1: " & Format(Activity_1_Timer,"hh:mm:ss")
    Debug.Print "Act 2: " & Format(Activity_2_Timer,"hh:mm:ss")
End Sub