XL 2016 calcul des heures de location

dindin

XLDnaute Occasionnel
Bonjour le forum,
depuis qq jours je bloque sur le calcul des heures (addition et soustraction) dans des textbox.
le formulaire propose à l'utilisateur de sélectionner jusqu'à 4 dates de location d'une salle :
1620979292850.png

selon le choix, la date du jour s'affiche automatiquement
les heures dans des combo de 07h du matin à minuit step 00:30

- le premier souci c'est le nombre d'heures de réservation si je sélectionne minuit en heure de fin (il me fait le calcul inversement voir photo : -07:00)

- le total des heures si je sélectionne 2 dates et plus ne fonctionne pas en rouge sur la photo:

1620979613589.png


- mon gros souci aussi est la calcul des heures de chauffage si la date sélectionnée est comprise entre 01 oct et 30 avril .
avec une formule ça fonctionne très bien :
VB:
=SI(ET(D26>=Début_Chauffage;D26<=fin_Chauffage);Y26;"0")
mais je n'arrive à la traduire en vba.
j'aurais besoin de votre aide car malgré mes essais je bloque depuis quelque jours.
et je n'arrive pas à avancer.
je vous joint le fichier après suppression des infos
 

Pièces jointes

  • 1620979182399.png
    1620979182399.png
    33.1 KB · Affichages: 19
  • 1620979556289.png
    1620979556289.png
    16.2 KB · Affichages: 7
  • Gestion des salles 2021.xlsm
    51.6 KB · Affichages: 16

ChTi160

XLDnaute Barbatruc
Bonsoir dindin
Bonsoir le Fil ,le Forum
Une approche perfectible je n'ai pas encore traité les heures de Chauffage Lol
On pourrait passer par des Class pour les OptionButton ,ComboBox et Boutons
Bonne fin de Soirée
jean marie
 

Pièces jointes

  • Gestion des salles 2021 (Chti160).xlsm
    48 KB · Affichages: 6

dindin

XLDnaute Occasionnel
Bonjour
Bonjour le Fil ,le Forum

j'ai découvert qu'il devrait y avoir des Boutons +et -

qu'en ait il ?
merci
Bonne Journée
jean marie
Bonjour le fil,
Ne pas tenir compte de ces tooltip. Pour poster mon message dans l'urgence j'ai fait un copier coller d'une autre userform que j'ai enlevé sur la version finale.
J'ai amélioré la saisie de la date avec un code que j'ai récupéré sur un autre site pour qu'elle devienne plus simple.
 

dindin

XLDnaute Occasionnel
Re
Ok !
jean marie
Désolé pour ce retard.

Code 1 pour les dates dans Texbox:

VB:
Private Sub tbD_Change()
    Dim d
    d = tbD.Value
    Select Case Len(d)
        Case 1
            If Not IsNumeric(d) Then d = ""
        Case 2
            If d Like "#/" Then
                d = 0 & d
            ElseIf Not IsNumeric(d) Then
                d = ""
            ElseIf CInt(d) > 31 Then
                d = ""
            Else
                d = d & "/"
            End If
        Case 3
        Case 4
            If Not IsNumeric(Right(d, 1)) Then d = Left(d, 3)
        Case 5
            If d Like "##/#/" Then
                Select Case CInt(Mid(d, 4, 1))
                    Case 1, 3, 5, 7, 8
                        d = Left(d, 3) & 0 & Right(d, 2)
                    Case 4, 6, 9
                        If CInt(Left(d, 2)) = 31 Then
                            d = Left(d, 3)
                        Else
                            d = Left(d, 3) & 0 & Right(d, 2)
                        End If
                    Case 2
                        If CInt(Left(d, 2)) > 29 Then
                            d = Left(d, 3)
                        Else
                            d = Left(d, 3) & 0 & Right(d, 2)
                        End If
                End Select
            ElseIf Not IsNumeric(Right(d, 2)) Then
                d = Left(d, 3)
            ElseIf CInt(Right(d, 2)) > 12 Then
                d = Left(d, 3)
            ElseIf CInt(Right(d, 2)) = 2 Then
                If CInt(Left(d, 2)) > 29 Then
                    d = Left(d, 3)
                Else
                    d = d & "/"
                End If
            Else
                If CInt(Left(d, 2)) = 31 Then
                    Select Case CInt(Right(d, 2))
                        Case 2, 4, 6, 9, 11
                            d = Left(d, 3)
                        Case Else
                            d = d & "/"
                    End Select
                Else
                    d = d & "/"
                End If
            End If
        Case 6
        Case 7
            If Not IsNumeric(Right(d, 1)) Then d = Left(d, 6)
        Case 8
            If Not IsNumeric(Right(d, 2)) Then d = Left(d, 6)
        Case 9
            If Not IsNumeric(Right(d, 3)) Then d = Left(d, 6)
        Case 10
            If Not IsNumeric(Right(d, 4)) Then
                d = Left(d, 6)
            Else
                If CInt(Mid(d, 4, 2)) = 2 And CInt(Left(d, 2)) = 29 Then
                    If CInt(Right(d, 2)) <> 0 Then
                        If CInt(Right(d, 2)) Mod 4 > 0 Then d = Left(d, 6)
                    Else
                        If CInt(Mid(d, 7, 2)) Mod 4 > 0 Then d = Left(d, 6)
                    End If
                End If
            End If
        Case Else
            d = ""
    End Select
    tbD.Value = d
End Sub

Private Sub tbD_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim d
    d = tbD.Value
    If Len(d) > 0 And Len(d) < 10 Then
        Cancel = True
    ElseIf Len(d) = 10 Then
        On Error Resume Next
        If IsError(CDate(d)) Then
            d = ""
            Cancel = True
            tbD.Value = d
        End If
        On Error GoTo 0
    End If
End Sub

Code 2 pour l'heure dans textbox :

Code:
Private Sub tbH_Change()
    Dim h
    h = tbH.Value
    Select Case Len(h)
        Case 1
            If Not IsNumeric(h) Then h = ""
        Case 2
            If h Like "#:" Then
                h = 0 & h
            ElseIf Not IsNumeric(h) Then
                h = ""
            ElseIf CInt(h) > 23 Then
                h = ""
            Else
                h = h & ":"
            End If
        Case 3
        Case 4
            If Not IsNumeric(Right(h, 1)) Then h = Left(h, 3)
        Case 5
            If Not IsNumeric(Right(h, 2)) Then
                h = Left(h, 3)
            ElseIf CInt(Right(h, 2)) > 59 Then
                h = Left(h, 3)
            End If
        Case Else
            h = ""
    End Select
    tbH.Value = h
End Sub

Private Sub tbH_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim h
    h = tbH.Value
    If Len(h) = 4 Then
        h = Left(h, 3) & 0 & Right(h, 1)
    ElseIf Len(h) = 3 Then
        h = h & "00"
    ElseIf Len(h) = 2 Or Len(h) = 1 Then
        Cancel = True
    End If
    If Len(h) = 5 Then
        On Error Resume Next
        If IsError(CDate(h)) Then
            h = ""
            Cancel = True
        End If
        On Error GoTo 0
    End If
    tbH.Value = h
End Sub


et un grand merci au développeur

Ci_joint le fichier en question comme promis

Encore merci Jean Marie
 

Pièces jointes

  • usfsaisiedateheurecontrolee.xlsm
    31.6 KB · Affichages: 4

dindin

XLDnaute Occasionnel
Bonjour le forum,

je me permet de relancer cette discussion, car je bloque sur ce point depuis quelques jours.

le souci est le suivant :
- comment peut-on adapter le code ci-dessous afin qu'il prenne en compte la règle suivante : Heure entamée= heure due ( même 5 mn)

c'est à dire :

- de 08:00 à 10:00 , je dois facturer 2h
- de 08:30 à 10:30 , je dois facturer 2h


par contre :

- de 08:00 à 10:30 , je dois facturer 3h00 et non pas 2h30 car la règle dit si la 3 ème heure est entamée, il faut la facturer 1h et non pas 30 mn.

le code est le suivant :
VB:
Private Sub calcul1_Click()

'calcul des heures de réservation
     Diff_n = DateDiff("n", heurede1, heurea1)
    Debut = CDate(heurede1): fin = CDate(heurea1)
    If fin = 0 Then fin = 1 ' si 0 alors 24:00
    nbreh1 = Format(fin - Debut, "hh:mm")
 
'calcul heures chauffage
If Chauffage(date1) = 1 Then chauf1 = nbreh1.Value Else chauf1 = 0

End Sub

Merci pour votre aide
 

Membres actuellement en ligne

Statistiques des forums

Discussions
290 755
Messages
1 910 208
Membres
176 538
dernier inscrit
Charlydebutant
Haut Bas