XL 2016 VBA Calcul heures négatives

tiitii60

XLDnaute Nouveau
Bonjour,

Je dois faire un calcul de différence d'heures en VBA, cela fonctionne mais le code que j'ai effectué ne prend pas en charge les différence d'heures négatives.
Quelqu'un pourrait il m'orienter sur une solution?

voici le code:


Sub CalculHeuresDiffSemaine()

Dim cellule As Range
Dim SelectionHeure As Date
Dim HeureReference As Date
Dim DifferenceHeure As Date


For Each cellule In Selection
If Selection <> "" Then

HeureReference = Range("JoursDeSemaine!H7").Value
SelectionHeure = cellule.Value
DifferenceHeure = Application.Text(SelectionHeure - HeureReference, "[h]:m;@")


MsgBox ("La différence d'heure(s) est de: " & Application.Text(DifferenceHeure, "[h]:mm;@") & " h")

Exit Sub

End If

Next cellule

End Sub

Merci pour votre aide.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Tititi,
Une solution parmi d'autre est de passer le calendrier en 1904 qui accepte les calculs d'heures négatif.
En faisant Options Excel/Options avancées et en cochant Utiliser le calendrier depuis 1904.
1626261977843.png
 

tiitii60

XLDnaute Nouveau
Bonjour Tititi,
Une solution parmi d'autre est de passer le calendrier en 1904 qui accepte les calculs d'heures négatif.
En faisant Options Excel/Options avancées et en cochant Utiliser le calendrier depuis 1904.
Regarde la pièce jointe 1110970
Option déjà cochée, mais merci pour l'information. Je pense qu'il y a possibilité de modifier mon code mais je ne parviens pas a trouver la solution ni la bonne fonction.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Option déjà cochée
Une solution, mais il doit y avoir plus simple, si les données sont en E13 G13, on construit le signe avec :
VB:
Sub CalculHeuresDiffSemaine()
    HeureReference = [E13]
    SelectionHeure = [G13]
    DifferenceHeure = SelectionHeure - HeureReference
    If DifferenceHeure < 0 Then S = "-" Else S = ""
    DifferenceHeure = S & Format(DifferenceHeure, "hh:mm") & "h"
    MsgBox ("La différence d'heure(s) est de: " & DifferenceHeure)
End Sub
 

tiitii60

XLDnaute Nouveau
Une solution, mais il doit y avoir plus simple, si les données sont en E13 G13, on construit le signe avec :
VB:
Sub CalculHeuresDiffSemaine()
    HeureReference = [E13]
    SelectionHeure = [G13]
    DifferenceHeure = SelectionHeure - HeureReference
    If DifferenceHeure < 0 Then S = "-" Else S = ""
    DifferenceHeure = S & Format(DifferenceHeure, "hh:mm") & "h"
    MsgBox ("La différence d'heure(s) est de: " & DifferenceHeure)
End Sub
Merci pour le code mais il reste la mise au format sans les secondes qui ne fonctionne pas pour ma partie.
on est proche du but.

Sub CalculHeuresDiffSemaine()

' *** Calcul la différence d'heures de la cellule selectionnée avec le nombre d'heures de reférence de travail ***

Dim cellule As Range
Dim SelectionHeure As Date
Dim HeureReference As Date
Dim DifferenceHeure As Date

Dim Signe

For Each cellule In Selection
If Selection <> "" Then

HeureReference = Range("JoursDeSemaine!H7").Value
SelectionHeure = cellule.Value
DifferenceHeure = SelectionHeure - HeureReference
If DifferenceHeure < 0 Then Signe = "-" Else Signe = ""


MsgBox ("La différence d'heure(s) est de: " & Application.Text(Signe & DifferenceHeure, "[h]:mm;@") & " h")

Exit Sub

End If

Next cellule


End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
303 601
Messages
2 012 553
Membres
219 335
dernier inscrit
nassim djouder