ADDITION OU SOUSTRACTION DE DEUX HEURES DE TYPE HH:MM:SS

' -----------------------------------------------------------------
' 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

14 novembre 2007 21:28:41 :

J'ai tout simplement annulé l'ancien code par ce nouveau plus concis, avec une fonction générique d'affichage d'une erreur de traitement.