XL 2016 Soustraction de format heure avec résultat négatif VBA

[Yabon21]

Bonjour à tous,
Je viens à vous car je suis complètement bloqué avec un bug qui se produit lorsque je lance, en VBA, une soustraction de deux cellules au format "heure" dont le résultat est négatif.
En gros je veux soustraire une heure réel de sortie avec une heure théorique de sortie. Le résultat est donc positif lorsque la sortie se fait en avance par rapport à l'heure théorique et négatif si la sortie se fait en retard par rapport à l'heure théorique.

je vous ai joins mon tableau excel.
Pour le tester voici des données à remplir dans les userform :
1/ lancer la macro en cliquant sur le bouton en haut à gauche du tableau
2/ renseigner N° de train 745633
3/ renseigner la case protection 3:42
4/renseigner la case présence CRTT 4:37
5/ valider ce qui lance le deuxième userform
5/ renseigner la case prêt au départ 5:12
6/ renseigner la case départ 5:15
7/ valider ce qui lance le troisième userform
8/ renseigner la case départ 5:35

les résultats obtenus doivent correspondre à cela :

E5 : -00:10
F5 : 00:00
G5 : 02:00
H5 : 04:00

Merci d'avance de votre aide!

 

[sylvanu]

Bonsoir Yabon,
Dans XL on peut gérer des calculs d'heures négatives en cochant dans Options avancées Utiliser le calendrier depuis 1904.
Mais attention quand il s'agit de dates, cela peut poser problème.

Programmation VBA :1904 valeurs de date pour les heures négatives

Programmation VBA :1904 valeurs de date pour les heures négatives

www.excelcorpo.com

 

[Yabon21]

Bonjour sylvanu, merci pour ta réponse.
Mon fichier est déjà en calendrier 1904.

 

[sylvanu]

Petit avancement.
J'ai fait un petit bout de code pour capter les valeurs reçues, j'ai appelé les variables par leur nom de cellules, plus simples à lire. On obtient :

Certaines cellules sont des nombres, mais certaines cellules sont des chaines de caractères, en particulier W5,L5,Q5,S5. Donc les calculs ne peuvent pas marcher. Reste à trouver pourquoi, et le résoudre.

En fait, tout ce qui vient des userforms sont des chaines de caractères, non des nombres.
Il faut donc transformer "5:35" en 5:35.

 

[Yabon21]

Oui c'est ce que je ne comprends pas. J'ai pourtant intégrer dans mon code le changement de format de chaque cellule avant le calcul :-/

 

[sylvanu]

Oui mais comme le type est chaine, un changement de format ne change rien.
Si on a Chaine="5:12" alors il faut faire Heure=5/24+12/1440.
Il faut splitter la chaine avec le séparateur ":"

 

[patricktoulon]

bonsoir
en vba pour le calcul de différence d'heure il y a application.text qui gère très bien sans faire le cumul
en addition
par exemple selon toi quel serait le résultat souhaité pour ceci

heure1 = CDate("01:28:00")
heure2 = CDate("08:54:12")
msgbox heure1-heure2

 

[Yabon21]

Donc c'est a ce moment la que tu me perds :-/
J'ai résisté quand même

 

[Yabon21]

bonsoir
en vba pour le calcul de différence d'heure il y a application.text qui gère très bien sans faire le cumul
en addition
par exemple selon toi quel serait le résultat souhaité pour ceci

heure1 = CDate("01:28:00")
heure2 = CDate("08:54:12")
msgbox heure1-heure2

- 07:26:12 ?
De tête comme ça a cette heure là c'est compliqué

 

[patricktoulon]

et ben alors

'soustraction
    heure1 = CDate("01:28:00")
    heure2 = CDate("08:54:12")
    If heure1 < heure2 Then temp = heure1: heure1 = heure2: heure2 = temp
    TH = heure1 - heure2

    'formatage avec la fonction ""Text"" de application
    MsgBox "soustraction  des heures : " & Application.text(TH, "[hh]:mm:ss")

et c'est pareil pour additionner on cumule au dela de 24:00:00 et sans inverser

'addition
    heure1 = CDate("23:17:08")
    heure2 = CDate("01:34:27")
    TH = heure1 + heure2

    'formatage avec la fonction ""Text"" de application
    MsgBox "cumul des heures : " & Application.text(TH, "[hh]:mm:ss")    'les crochets associés a app.text  indiquent que les heures se cumulent au dela de 24

    'sans formatage on obtient un  temps
    MsgBox "temps résultant :" & Format(TH, "hh:mm:ss")

 

[Yabon21]

et ben alors

'soustraction
    heure1 = CDate("01:28:00")
    heure2 = CDate("08:54:12")
    If heure1 < heure2 Then temp = heure1: heure1 = heure2: heure2 = temp
    TH = heure1 - heure2

    'formatage avec la fonction ""Text"" de application
    MsgBox "soustraction  des heures : " & Application.text(TH, "[hh]:mm:ss")

Waouu me voila perdu une deuxième fois en 10 minutes
Si j'essaie de comprendre :
1/("01:28:00") et ("08:54:12") sont à remplacer par mes valeurs sources? Feuil1.cells(X,X).value?
2/ je ne comprends pas comment diriger le résultat vers une cellule.
Est ce comme ça? Feuil1.cells(X,X).Application.text(TH, "[hh]:mm:ss")

 

[patricktoulon]

ben oui c'est comme ça tu vois perdu que dans ta tete tu l'es

 

[Yabon21]

Ca me met une erreur de syntaxe pourtant sur la dernière ligne

    heure1 = CDate(Feuil1.Cells(5, 23))
    heure2 = CDate(Feuil1.Cells(5, 16))
    If heure1 < heure2 Then temp = heure1: heure1 = heure2: heure2 = temp
    TH = heure1 - heure2

   Feuil1.Cells(5, 3).Application.Text(TH, "[hh]:mm:ss")

 

[sylvanu]

Bonjour Yabon, Patrick,
Une autre solution, c'est, une fois posé les textbox en ligne 5 de lancer une conversion sur toute la ligne, avec :

Sub Convertir()
For C = 1 To 38
    If Sheets("SENS IMPAIR").Cells(5, C) Like "*:*" Then
        Sheets("SENS IMPAIR").Cells(5, C) = CDate(Sheets("SENS IMPAIR").Cells(5, C))
    End If
Next C
End Sub

De cette façon tous les chaines comportant ":" seront transformées en heures.

 

[patricktoulon]

oh! non de dieu!!
Feuil1.Cells(5, 3).value =Application.Text(TH, "[hh]:mm:ss")