Format heure et calcul

[Jean-luc1311]

Bonjour à tous,

Tout d'abord, j'ai un problème de format dans mes comboBox heure début et heure de fin.

Je voudrai suivant l'exemple ci-joint, pouvoir calculer la différence entre l'heure de début et de fin (le résultat s'affichant dans le textBox "total_Journee" auquel il faudrait retrancher 30mn de pause).

Il faudrait considérer que la journée peut commencer vers 20h et finir à 3h30 du matin comme commencer à 9h et finir à 16h30.

Ce résultat devra rester unique par personne et pour une date donnée et non pas pour une date différente (archivé en feuille "heures").

Les calculs sur les dates et les heures restent un gros souci pour moi.
Merci pour toute aide que vous pourrez m'apporter.

A+

😕

 

[jp14]

Re : Format heure et calcul

Bonjour

Ci dessous le code pour calculer les heures.

A tester

Private Sub Heure_Debut_Change()
If Heure_Debut.ListIndex = -1 Then Exit Sub
If Heure_Fin.ListIndex = -1 Then Exit Sub
Call calculheure
End Sub

Private Sub Heure_Fin_Change()
If Heure_Debut.ListIndex = -1 Then Exit Sub
If Heure_Fin.ListIndex = -1 Then Exit Sub
Call calculheure
End Sub


Private Sub UserForm_Initialize()
Dim listh As Range
Dim i As Byte
NomTech.List = Range("ListeNoms").Value
Organisation.List = Range("ListeOrganisation").Value
Set listh = Range("ListeHeures")
For Each cell In listh
    Heure_Debut.AddItem Format(cell.Value, "hh:nn")
    Heure_Fin.AddItem Format(cell.Value, "hh:nn")
Next cell

Jour.List = Range("ListeJours").Value
For i = 1 To 12
Mois.AddItem MonthName(i)
Next i
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
Private Sub calculheure()
Dim dated As Date
Dim datef As Date
Dim minuit As Date
Dim tablo() As String
tablo = Split(Heure_Debut, ":")
dated = TimeSerial(tablo(0), tablo(1), 0)
tablo = Split(Heure_Fin, ":")
datef = TimeSerial(tablo(0), tablo(1), 0)
minuit = TimeSerial(24, 0, 0)
If datef > dated Then Me.Total_Journee = Format(datef - dated, "hh:nn")
If datef < dated Then Me.Total_Journee = Format((minuit - dated) + datef, "hh:nn")




End Sub

Pour tenir compte d'une pause, il faut rajouter

Dim pause As Date
pause = TimeSerial(0, 30, 0)
If datef > dated Then Me.Total_Journee = Format(datef - dated - pause, "hh:nn")
If datef < dated Then Me.Total_Journee = Format((minuit - dated) + datef - pause, "hh:nn")

JP

 

[Jean-luc1311]

Re : Format heure et calcul

Merci JP14,

Je teste ta solution et reviens vers toi si je rencontre un souci.

A+

 

[Jean-luc1311]

Re : Format heure et calcul

Bonsoir JP14, bonsoir à tous,

super ça marche impéccablement.
Pour finir, comment je peux faire pour éviter les doublons dans la feuille Heures, lorsque je saisie plusieurs opérations pour la même personne le même jour?

dans l'attente, merci

A+

 

[jp14]

Re : Format heure et calcul

Bonsoir

Code à modifier

Private Sub CommandButton1_Click()
....................................................
        .HorizontalAlignment = xlCenter
    End With
Dim lig As Long
lig = rechercheligne("Heures", 1, Array(0, 1, 2), Array(NomTech.Value, Jour.Value, Mois.Value))
If lig <> 0 Then
Call MsgBox("Vous avez déjà renseigné la base" _
            & vbCrLf & "Nom : " & NomTech.Value _
            & vbCrLf & "Jour : " & Jour.Value _
            & vbCrLf & "Mois : " & Mois.Value _
            , vbInformation, Application.Name)

exit sub

End If

    With Sheets("Heures")
 ...........................................

End Sub


Private Function rechercheligne(£nomfeuille As String, £colonne As Byte, £offset As Variant, £valeur As Variant)
Dim £cellule As Range
If UBound(£valeur) <> UBound(£offset) Then
Call MsgBox("Erreur ", vbCritical, Application.Name)
End If
rechercheligne = 0
For Each £cellule In Sheets(£nomfeuille).UsedRange.Columns(£colonne).Cells
    For £i = LBound(£valeur) To UBound(£valeur)
£trouve = False
    For £i = LBound(£valeur) To UBound(£valeur)
        If CStr(£cellule.Offset(0, £offset(£i))) <> £valeur(£i) Then
            £trouve = True
            Exit For
        End If
    Next £i
    If £trouve = False Then

        rechercheligne = £cellule.Row
        Exit For
    End If
Next £cellule
End Function

A tester

JP

 

[Jean-luc1311]

Re : Format heure et calcul

Merci JP14,

Je teste ton complément de solution.
Merci pour ton aide.

A+ et bonne soirée.

JL

 

[Jean-luc1311]

Re : Format heure et calcul

Bonsoir à tous,

J'ai testé la solution de JP14, et j'ai un souci.
Je viens bien écrire les données sur la première feuille ("Données"), mais le message pour m'avertir d'une double saisie apparaît alors que rien n'a encore était écrit sur la feuille "heures".

J'ai vraiment besoin d'aide pour comprendre.

Merci à tous et bonne soirée.

😕

 

[jp14]

Re : Format heure et calcul

Bonsoir

Effectivement il y avait un problème j'ai corrigé la procédure du post précédent.

JP

 

[Jean-luc1311]

Re : Format heure et calcul

Bonsoir à toi JP14,

Tu aurai pas oublié de joindre la modif à ton post ?

A+