XL 2016 VBA Calcul heures négatives

[tiitii60]

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]

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.

 

[tiitii60]

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]

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 :

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]

Une solution, mais il doit y avoir plus simple, si les données sont en E13 G13, on construit le signe avec :

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

 

[sylvanu]

il reste la mise au format sans les secondes

J'ai du mal à vous suivre. Ma macro n'affiche pas les secondes, il donne par ex :

 

[tiitii60]

J'ai du mal à vous suivre. Ma macro n'affiche pas les secondes, il donne par ex :
Regarde la pièce jointe 1110987

c'est OK, j'ai supprimé l'affectation du type variable "Date" et remplacé le format "Application.Text" par format comme votre code est cela fonctionne maintenant. merci pour votre aide.