OnTime 时间戳值加倍

编程入门 行业动态 更新时间:2024-10-26 22:30:04
本文介绍了OnTime 时间戳值加倍的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

限时送ChatGPT账号..

当您启动 RecordData() sub(来自 OpenMe() sub)时,它可以完美运行.每个时间戳日志都是连续的,没有重复.当工作簿再次重新打开时(由于 OpenMe()/Close() subs),它会创建重复的时间戳日志.我可以重新安排 OnTime 以便它不会为下一个会话安排双人吗?或者以某种方式将两个 OnTime 分开,以便它们独立?

When you launch RecordData() sub (from OpenMe() sub) just once it works perfectly. Each time stamp log is consecutive with no doubles. Its when the workbook, re-opens again (due to OpenMe()/Close() subs) is when it creates a duplicate time stamp log. Can I re-arrange the OnTime so it doesn't schedule a double for its next session? Or separate the two OnTime's somehow so their independent?

Dim NextTime As Double
Sub RecordData()
    Dim Interval As Double
    Dim cel As Range, Capture As Range

    Application.StatusBar = "Recording Started"
    Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
    With Worksheets("Journal") 'Record the data on this worksheet
        Set cel = .Range("A2") 'First timestamp goes here
        Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
        cel.Value = Now
        cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
    End With
    NextTime = Now + TimeValue("00:01:00")
    Application.OnTime NextTime, "RecordData"
End Sub

Sub StopRecordingData()
    Application.StatusBar = "Recording Stopped"
    Application.OnTime NextTime, "OpenMe", , False
End Sub

Sub OpenMe()
    Call RecordData
    Application.OnTime Now + TimeValue("00:10:00"), "CloseMe"
End Sub

Sub CloseMe()
    Application.OnTime Now + TimeValue("00:00:10"), "OpenMe"
    ThisWorkbook.Close True
End Sub

推荐答案

这是一个等待子示例:

注意:此功能仅在 excel 中可用.

NOTE: This function is only available in excel.

Option Explicit

Dim vntNextTime As Variant
Dim blnStopExecution As Boolean

Const c_strTotalRecordDataWaitTime As String = "00:05:00"
Const c_strCloseAndStopWaitTime As String = "00:00:30"


'This should be on the same sheet as your button!
Private Sub CommandButton1_Click()
    StopRecordingData
End Sub

'Private Sub WaitFor(intHrs As Integer, intMins As Integer, intSecs As Integer)
'    Dim newHour As Integer
'    Dim newMinute As Integer
'    Dim newSecond As Integer
'
'    Dim waitTime As Variant
'
'    newHour = Hour(Now()) + intHrs
'    newMinute = Minute(Now) + intMins
'    newSecond = Second(Now()) + intSecs
'
'    waitTime = TimeSerial(newHour, newMinute, newSecond)
'
'    Application.Wait waitTime
'End Sub

    Private Function CombineTime(intHrs As Integer, intMins As Integer, intSecs As Integer) As Long
        Dim lngTime As Long

        lngTime = intSecs + intMins * 60 + intHrs * 3600
        CombineTime = lngTime
    End Function

    Public Function GetTimeFromString(strInTime As String) As Long
        Dim strSplit() As String
        Dim intHrs As Integer
        Dim intMins As Integer
        Dim intSecs As Integer

        strSplit = Split(strInTime, ":")
        intHrs = CInt(strSplit(0))
        intMins = CInt(strSplit(1))
        intSecs = CInt(strSplit(2))

        GetTimeFromString = CombineTime(intHrs, intMins, intSecs)
    End Function


    Private Sub WaitFor(intHrs As Long, intMins As Long, intSecs As Long)
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer
        Dim CurTime As Variant

        Dim waitTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        waitTime = TimeSerial(newHour, newMinute, newSecond)

        'This is bad practice, but it will work for what you need.
        CurTime = 0
        Do While CurTime < waitTime
            newHour = Hour(Now())
            newMinute = Minute(Now)
            newSecond = Second(Now())

            CurTime = TimeSerial(newHour, newMinute, newSecond)
            DoEvents
            If blnStopExecution Then Exit Do
        Loop
        'Application.Wait waitTime
    End Sub


    Private Function GetNextTime(intHrs As Long, intMins As Long, intSecs As Long) As Variant
        Dim newHour As Integer
        Dim newMinute As Integer
        Dim newSecond As Integer

        Dim vntThisNextTime As Variant

        newHour = Hour(Now()) + intHrs
        newMinute = Minute(Now) + intMins
        newSecond = Second(Now()) + intSecs

        vntThisNextTime = TimeSerial(newHour, newMinute, newSecond)

        GetNextTime = vntThisNextTime
    End Function

    Private Sub RecordData()
        Dim Interval As Double
        Dim cel As Range, Capture As Range
        Dim intI As Integer
        Dim lngTimeStep As Long

        Application.StatusBar = "Recording Started"

        lngTimeStep = GetTimeFromString(c_strTotalRecordDataWaitTime) / 10

        For intI = 0 To 9
            WaitFor 0, 0, lngTimeStep
            If blnStopExecution Then Exit For

            Set Capture = Worksheets("Dashboard").Range("C5:K5") 'Capture this row of data
            With Worksheets("Journal") 'Record the data on this worksheet
                Set cel = .Range("A2") 'First timestamp goes here
                Set cel = .Cells(.Rows.Count, cel.Column).End(xlUp).Offset(1, 0)
                cel.Value = Now
                cel.Offset(0, 1).Resize(1, Capture.Cells.Count).Value = Capture.Value
            End With
        Next intI
    End Sub

    Public Sub OpenMe()
        blnStopExecution = False
        Call RecordData
        Call CloseMe
    End Sub

   Public Sub CloseMe()
        blnStopExecution = True

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"  'Now + TimeValue("00:00:10"), "OpenMe"

        ThisWorkbook.Close True
    End Sub

    Public Sub StopRecordingData()
        blnStopExecution = True
        Application.StatusBar = "Recording Stopped"

        vntNextTime = GetNextTime(0, 0, GetTimeFromString(c_strCloseAndStopWaitTime))
        Application.OnTime vntNextTime, "OpenMe"
    End Sub

'我想以一分钟为间隔记录/记录数据,然后关闭工作簿'在 10 分钟内,然后在 10 秒后重新打开

'I want to log/record the data in one minute intervals, then close the workbook 'in 10 minutes, and then reopen in 10 seconds

这篇关于OnTime 时间戳值加倍的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

更多推荐

[db:关键词]

本文发布于:2023-04-30 12:14:27,感谢您对本站的认可!
本文链接:https://www.elefans.com/category/jswz/34/1393520.html
版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系,我们将在24小时内删除。
本文标签:时间   OnTime

发布评论

评论列表 (有 0 条评论)
草根站长

>www.elefans.com

编程频道|电子爱好者 - 技术资讯及电子产品介绍!