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

sylvanu · 14 Mai 2021

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

dindin · 15 Mai 2021

Merci beaucoup Sylvanu
Je regarde ça ce weekend

dindin · 15 Mai 2021

sylvanu à dit:

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.

sylvanu · 15 Mai 2021

Bonjour,
Dans votre module TotalH_Change, D est déclaré comme Date, donc limité à 24H.
Ne typez pas D et dans ce cas il est compatible du reste ( horaire et décimal )
A faire partout, évidemment.

VB:

Dim D, TB, Resultat As Double

dindin · 15 Mai 2021

dindin à dit:
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 · 18 Mai 2021

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 · 18 Mai 2021

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

dindin · 18 Mai 2021

sylvanu à dit:
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 · 18 Mai 2021

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 · 10 Juin 2021

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

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 · 13 Juin 2021

sylvanu à dit:

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 · 13 Juin 2021

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.

dindin · 13 Juin 2021

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

soan · 13 Juin 2021

Bonsoir,

à tout hasard, essayer avec cette option avancée Excel,
rubrique « Lors du calcul de ce classeur » :

☑ Définir le calcul avec la précision au format affiché

soan

XL 2016 calcul des heures de location

dindin

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

dindin

XLDnaute Occasionnel

dindin

XLDnaute Occasionnel

Pièces jointes

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

dindin

XLDnaute Occasionnel

soan

XLDnaute Barbatruc

Discussions similaires