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

Soyez le premier à donner votre avis sur cette source.

Snippet vu 14 643 fois - Téléchargée 71 fois


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

Ajouter un commentaire

Commentaires

Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
57 -
Pas utilisable, il manque une fonction...

place la dans CE code-ci, on ne va pas faire un jeu de piste, non !

sera supprimé sans cela.
Noiretulipe
Messages postés
165
Date d'inscription
mardi 21 janvier 2003
Statut
Membre
Dernière intervention
13 juillet 2008
-
C clair ....
GarnetDiAlexandros
Messages postés
55
Date d'inscription
mercredi 31 juillet 2002
Statut
Membre
Dernière intervention
19 novembre 2004
-
Pas très pratique ce code qui renvoie à une fonction qui est dans une autre source...Tu aurais pu la rappeler ici, en mettant le nom de son auteur...
Bof bof !

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.