XL 2016 calcul des heures de location

dindin · 14 Mai 2021

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 :

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:

- 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

ChTi160 · 14 Juin 2021

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

dindin · 15 Juin 2021

ChTi160 à dit:
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

Merci Jean Marie pour cette solution.

ChTi160 · 16 Juin 2021

Bonjour
Bonjour le Fil ,le Forum

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

utilisez les boutons + et -

qu'en ait il ?
merci
Bonne Journée
jean marie

soan · 16 Juin 2021

Bonjour Jean-Marie,

moi aussi, j'ai découvert qu'il devrait toujours y avoir des boutons + et - sur une calculatrice !

(les grands esprits se rencontrent, hein ? )

soan

ChTi160 · 16 Juin 2021

Bonjour dindin
Bonjour Soan
Je vois que tu es en forme ( comme dab ) lol
J'attends le retour de dindin
Bonne journée
Jean marie

dindin · 16 Juin 2021

ChTi160 à dit:
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.

ChTi160 · 16 Juin 2021

Bonjour dindin
Pourrais tu joindre un exemplaire du userform qui contient cette façon de saisir la date ?
Jean marie

dindin · 16 Juin 2021

Là je suis à l'extérieur. Je le ferai dans l'après midi en rentrant. Le code est trop complexe pour moi mais qui fonctionne très bien.

ChTi160 · 16 Juin 2021

Re
Ok !
jean marie

dindin · 16 Juin 2021

ChTi160 à dit:
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

dindin · 14 Septembre 2021

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

ChTi160 · 14 Septembre 2021

Bonjour dindin
pas de fichier ?
bonne journée
jean marie

dindin · 14 Septembre 2021

ChTi160 à dit:
Bonjour dindin
pas de fichier ?
bonne journée
jean marie

merci Jean marie pour ta réponse

ton code me donne ceci :

je te joins le fichier dans l'après midi.
c'est un peu confidentiel le temps de l'adapter

ChTi160 · 14 Septembre 2021

Re
oui j'ai vu et modifié le Post
je cherche lol
jean marie

dindin · 14 Septembre 2021

ChTi160 à dit:
Re
oui j'ai vu et modifié le Post
je cherche lol
jean marie

ci-joint le fichier type

XL 2016 calcul des heures de location

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums