Calcul sur deux temps passés en arguments de format hh:mm:ss - Addition ou soustraction.
J'avais mis dans un premier temps un code un lourd que j'avais réalisé et qui n'était pas complet (honte à moi). Celui-ci est plus smart, mais je ne sais plus si je ne l'ai pas pompé quelque part (désolé pour son auteur orginal) et modifié à ma sauce.
Si cela peut aider un débutant à programmer, c'est le principal.
Source / Exemple :
' -----------------------------------------------------------------
' Pour une addition typeOp=0, pour une soustraction typeOp=1
'
Public Function AddOrSubHour(theHour1 As String, theHour2 As String, Optional ByVal typeOp As Integer = 0) As String
On Local Error GoTo ERROR_AddOrSubHour
Dim theSum As Double, theDiff As Double
Select Case typeOp
Case 0
theSum = Val(DatePart("h", theHour1)) * 3600 + Val(DatePart("n", theHour1)) * 60 + Val(DatePart("s", theHour1)) + Val(DatePart("h", theHour2)) * 3600 + Val(DatePart("n", theHour2)) * 60 + Val(DatePart("s", theHour2))
AddOrSubHour = str$(theSum \ 3600) + ":" + str$((theSum - (theSum \ 3600) * 3600) \ 60) + ":" _
+ str$(theSum - ((theSum \ 3600) * 3600) - ((theSum - (theSum \ 3600) * 3600) \ 60) * 60)
Case 1
theDiff = Val(DatePart("h", theHour1)) * 3600 + Val(DatePart("n", theHour1)) * 60 + Val(DatePart("s", theHour1)) - Val(DatePart("h", theHour2)) * 3600 - Val(DatePart("n", theHour2)) * 60 - Val(DatePart("s", theHour2))
AddOrSubHour = str$(theDiff \ 3600) + ":" + str$((theDiff - (theDiff \ 3600) * 3600) \ 60) + ":" + _
str$(theDiff - ((theDiff \ 3600) * 3600) - ((theDiff - (theDiff \ 3600) * 3600) \ 60) * 60)
End Select
Exit Function
ERROR_AddOrSubHour:
Call AlertDialog("Error on Hour Operation(" & theHour1 & cESPACE & theHour2 & cESPACE & typeOp & ")")
End Function
' ---------------------------------------------------------------------
' Affiche un message dans une boite de dialog de type Message d'Erreur
'
Sub AlertDialog(ByVal leMsg As String, Optional ByVal displayIt As Boolean = False)
On Local Error Resume Next
Dim errDLL As String, lErreur As String
Screen.MousePointer = vbDefault
lErreur = IIf(Err.Number = 0, vbNullString, vbCrLf & vbCrLf & "Error #" & CStr(Err.Number) & _
IIf(Erl, " - Line n° " & Erl, vbNullString) & " by " & Err.Source & _
IIf(Err.Description <> vbNullString, vbCrLf & Err.Description, vbNullString) & _
IIf(errDLL <> vbNullString, vbCrLf & vbCrLf & errDLL, vbNullString))
If displayIt = True Then
Call MsgBox(leMsg & lErreur, _
vbCritical Or vbOKOnly Or vbDefaultButton1 Or vbApplicationModal Or vbMsgBoxSetForeground, "Error message", Err.HelpFile, Err.HelpContext)
End If
Call Err.Clear
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.