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: 42
  • 1620979556289.png
    1620979556289.png
    16.2 KB · Affichages: 33
  • Gestion des salles 2021.xlsm
    51.6 KB · Affichages: 18

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Dindin,
Un essai en PJ, peu esthétique mais qui marche.
J'ai modifié que le premier créneau avec :
VB:
Private Sub calcul1_Click()
    'heurea1.Value = Format(heurea1.Value, "hh:mm")
    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")
End Sub

et

Private Sub nbreh1_Change()
    If nbreh1 = "" Then nbreh1 = 0
    If nbreh2 = "" Then nbreh2 = 0
    If nbreh3 = "" Then nbreh3 = 0
    If nbreh4 = "" Then nbreh4 = 0
    TotalH = Application.Text(CDate(nbreh1) + CDate(nbreh2) + CDate(nbreh3) + CDate(nbreh4), "[h]:mm")
End Sub
 

Pièces jointes

  • Gestion des salles 2021 (2).xlsm
    32.8 KB · Affichages: 10

dindin

XLDnaute Occasionnel
Bonsoir Dindin,
Un essai en PJ, peu esthétique mais qui marche.
J'ai modifié que le premier créneau avec :
VB:
Private Sub calcul1_Click()
    'heurea1.Value = Format(heurea1.Value, "hh:mm")
    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")
End Sub

et

Private Sub nbreh1_Change()
    If nbreh1 = "" Then nbreh1 = 0
    If nbreh2 = "" Then nbreh2 = 0
    If nbreh3 = "" Then nbreh3 = 0
    If nbreh4 = "" Then nbreh4 = 0
    TotalH = Application.Text(CDate(nbreh1) + CDate(nbreh2) + CDate(nbreh3) + CDate(nbreh4), "[h]:mm")
End Sub

Merci beaucoup,
j'ai appliqué ton code sur le reste des dates.
j'ai réussi à convertir les heures en décimal afin de calculer les frais de location en utilisant ce code :
VB:
Private Sub TotalH_Change()
Dim D As Date, TB, Resultat As Double
    'Pour l'exemple, mais ça peu être en string
    D = TotalH.Value
    TB = Split(D, ":")
    TextBox72.Value = (TB(0) + ((TB(1) * 100) / 60) / 100) * 10
    Resultat = TextBox72.Value
End Sub
ce code fonctionne très bien sauf que si' le nombre des heures cumulées dépasse 24h il m'affiche une erreur d'incompatibilité
je joins le fichier si qq un peut m'aider avec un grand merci.
 

Pièces jointes

  • Gestion des salles 2021 (2).xlsm
    40.5 KB · Affichages: 10

dindin

XLDnaute Occasionnel
Merci beaucoup,
j'ai appliqué ton code sur le reste des dates.
j'ai réussi à convertir les heures en décimal afin de calculer les frais de location en utilisant ce code :
VB:
Private Sub TotalH_Change()
Dim D As Date, TB, Resultat As Double
    'Pour l'exemple, mais ça peu être en string
    D = TotalH.Value
    TB = Split(D, ":")
    TextBox72.Value = (TB(0) + ((TB(1) * 100) / 60) / 100) * 10
    Resultat = TextBox72.Value
End Sub
ce code fonctionne très bien sauf que si' le nombre des heures cumulées dépasse 24h il m'affiche une erreur d'incompatibilité
je joins le fichier si qq un peut m'aider avec un grand merci.
Merci encore une fois
 

dindin

XLDnaute Occasionnel
Comment peut-on adapter ce code afin qu'il calcule les heures de chauffage :
- la condition est la suivante : si la date de réservation se trouve entre 1 er octobre et le 30 avril on affiche le nombre d'heures déjà calculer auparavant sinon il affiche 0.
seul souci : ne pas tenir compte de l'année de la date en question car elle peut s'étaler sur plusieurs années( autrement dit : le client peut réservé pour 2020 ou 2021 ou même 2023)
Voici le code :
VB:
'calcul des heures chauffage
    Dim début, fine As Date ' déclaration des variables'
 
    début = label_début.Caption  '01/10 début octobre
    fine = label_fin.Caption   ' 30/04' fin avril
  
    If date1.Value >= CDate(Day(début) & "/" & Month(début) & "/" & Year(début)) And date1.Value <= CDate(Day(fine) & "/" & Month(fine) & "/" & Year(fine)) Then
 
    chauf1.Value = nbreh1.Value ' heure déjà calculer'
    Else
     chauf1.Value = 0
    End If
merci pour votre aide
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Dindin,
Vous pouvez utiliser cette fonction :
VB:
Function Chauffage(D As Date)
' Chauffage renvoie 1 si la date est comprise entre le 01/10 et le 30/04 sinon renvoie 0
' 01/10 est le 273eme jour, 30/04 est le 119eme jour
    NumJour = D - CDate("01/01/" & Year(D)) '+ 1
    If NumJour >= 273 And NumJour <= 366 Or NumJour >= 0 And NumJour <= 119 Then Chauffage = 1
End Function
la fonction vous renvoie 1 s'il faut mettre le chauffage, sinon elle renvoie 0.
Vous pouvez l'utilisez comme ça ( non testé ) :
Code:
If Chauffage(date1) = 1 Then chauf1 = nbreh1.Value Else chauf1 = 0
 

Pièces jointes

  • Chauffage.xlsm
    15.6 KB · Affichages: 10
Dernière édition:

dindin

XLDnaute Occasionnel
Bonjour Dindin,
Vous pouvez utiliser cette fonction :
VB:
Function Chauffage(D As Date)
' Chauffage renvoie 1 si la date est comprise entre le 01/10 et le 30/04 sinon renvoie 0
' 01/10 est le 273eme jour, 30/04 est le 119eme jour
    NumJour = D - CDate("01/01/" & Year(D)) '+ 1
    If NumJour >= 273 And NumJour <= 366 Or NumJour >= 0 And NumJour <= 119 Then Chauffage = 1
End Function
la fonction vous renvoie 1 s'il faut mettre le chauffage, sinon elle renvoie 0.
Vous pouvez l'utilisez comme ça ( non testé ) :
Code:
If Chauffage(date1) = 1 Then chauf1 = nbreh1.Value Else chauf1 = 0
Encore un grand merci
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Un petit peu plus rapide,
VB:
Function Chauffage(D As Date)
' Chauffage renvoie 1 si la date est comprise entre le 01/10 et le 30/04 sinon renvoie 0
' 01/10 est le 273eme jour, 01/04 est le 119eme jour
    NumJour = D - CDate("01/01/" & Year(D))
    If NumJour < 273 And NumJour > 119 Then Chauffage = 0 Else Chauffage = 1
End Function
 

dindin

XLDnaute Occasionnel
bonjour le forum
je me permet de relancer la discussion cernant un bug bizarre que je n'arrive pas à résoudre :

1623334754603.png


en sélectionnant 12:00 la combocbox affiche 00:00 ce qui fausse mes calculs.

j'ai essayer ce format :

VB:
heurea1.Value = Format(heurea1.Value, "hh:mm")

ou

heurea1.Value = Format(heurea1.Value, "[h]:mm")

comment peut-on remédier à ce bug qui persiste uniquement avec 12:00, tout le reste fonctionne.
Merci pour votre aide.
 

dindin

XLDnaute Occasionnel
Un petit peu plus rapide,
VB:
Function Chauffage(D As Date)
' Chauffage renvoie 1 si la date est comprise entre le 01/10 et le 30/04 sinon renvoie 0
' 01/10 est le 273eme jour, 01/04 est le 119eme jour
    NumJour = D - CDate("01/01/" & Year(D))
    If NumJour < 273 And NumJour > 119 Then Chauffage = 0 Else Chauffage = 1
End Function
Bonjour, pouvez vous regarder mon post précédent. Si vous pouvez faire qq chose. Merci
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour,
je n'ai pas trop compris pourquoi le problème se situait uniquement pour 12:00, peut être un problème d'arrondi.
Une façon "inélégante" de résoudre le problème est d'ajouter dans heures : =E8+"00:30"+1/1000000
Le petit epsilon ne change rien au résultat mais permet bizarrement de résoudre le pb.
 

Pièces jointes

  • Gestion des salles 2021 (2) (2).xlsm
    33 KB · Affichages: 6

dindin

XLDnaute Occasionnel
Bonjour,
je n'ai pas trop compris pourquoi le problème se situait uniquement pour 12:00, peut être un problème d'arrondi.
Une façon "inélégante" de résoudre le problème est d'ajouter dans heures : =E8+"00:30"+1/1000000
Le petit epsilon ne change rien au résultat mais permet bizarrement de résoudre le pb.
Un bug très étrange.
Mais je regarde votre solution.
Merci
 

Discussions similaires

Réponses
15
Affichages
319

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510