Addition ou soustraction de deux heures de type hh:mm:ss


Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.

Du même auteur (blq)