MyTetra Share
Делитесь знаниями!
Вычисление времени
16.03.2019
23:43
Текстовые метки: vba, Вычисление времени
Раздел: !Закладки - VBA - Операции с датами-временем

'==============================================================================================

' ##### Вычисление времени

'

'Sub test_FnStBarTimer()

' t = Timer

' For i = 1 To 100

' Статус_бар = FnTimer(Timer - t)

' Stop

' Next i

' Статус_бар = FnStBar("")

'End Sub

'------------------------------------------------------------------------------------------------

Function FnTimer(ByVal sinTimer As Single) As String

Const lngHour_1 As Integer = 3600

Const lngMin_1 As Integer = 60

Dim lngHour As Long, strHour As String

Dim lngMin As Long, strMin As String

Dim lngSec As Long, strSec As String

Dim lngDeltaSec As Long

Dim strBarTimer As String


lngHour = Fix(sinTimer / lngHour_1): strHour = lngHour

lngMin = Fix((sinTimer - lngHour_1 * lngHour) / lngMin_1): strMin = lngMin

lngSec = (sinTimer - (lngHour_1 * lngHour) - (lngMin_1 * lngMin)): strSec = lngSec

'If lngSec < 0 Then lngSec = lngSec * -1


If Len(strHour) = 1 Then strHour = "0" & strHour

If Len(strMin) = 1 Then strMin = "0" & strMin

If Len(strSec) = 1 Then strSec = "0" & strSec


FnTimer = strHour & ":" & strMin & ":" & strSec


Application.StatusBar = FnTimer

DoEvents

End Function

'================================================================================================



'==============================================================================================

' ##### Вычисление времени

'

'----------------------------------------------------------------------------------------------

'Sub test_FnStrTime()

'Dim strTime As String

' strTime = FnStrTime("01.02.2018 23:58:00", "")

' Debug.Print strTime

'End Sub

Function FnStrTime(ByVal strDateStart As String, _

ByVal strDateEnd As String) As String

Const lngHour_1 As Integer = 3600

Const lngMin_1 As Integer = 60


Dim lngHour As Long, strHour As String

Dim lngMin As Long, strMin As String

Dim lngSec As Long, strSec As String

Dim lngDeltaSec As Long


If Len(strDateEnd) = 0 Then strDateEnd = Now

'lngDeltaSec = DateDiff("s", strDate1, strDate2, vbUseSystemDayOfWeek, vbFirstJan1)

lngDeltaSec = DateDiff("s", strDateStart, strDateEnd)

lngHour = Fix(lngDeltaSec / lngHour_1): strHour = lngHour

lngMin = Fix((lngDeltaSec - lngHour_1 * lngHour) / lngMin_1): strMin = lngMin

lngSec = (lngDeltaSec - (lngHour_1 * lngHour) - (lngMin_1 * lngMin)): strSec = lngSec

'If lngSec < 0 Then lngSec = lngSec * -1


If Len(strHour) = 1 Then strHour = "0" & strHour

If Len(strMin) = 1 Then strMin = "0" & strMin

If Len(strSec) = 1 Then strSec = "0" & strSec


FnStrTime = strHour & ":" & strMin & ":" & strSec

' FnStrTime = TimeSerial(lngHour, lngMin, lngSec)

End Function

'==============================================================================================

 
MyTetra Share v.0.52
Яндекс индекс цитирования