Microsoft 365 compter le temps passé sur une ligne et cumuler tous les temps passés

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous :)

Voilà plusieurs jours que je planche sur un nouveau besoin et, pour l'instant, malgré tests et recherches, je n'y suis pas encore arrivé.

Contexte
Dans le fichier test joint, j'ai les suivants :
- ligne 6 masquée (hauteur 0),
- lignes 7 à 10 contiennent des informations à afficher "clairement" quand clic sur une cellule,

Code feuille Test
VB:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("a7:s20000")) Is Nothing Then
    If R.RowHeight = 300 Then
    Cells(ActiveCell.Row, 1).Select
    [a1].Select
    ActiveWindow.ScrollRow = Selection.Row
    Else
    SupprFormats
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Rows("6:6").Copy
    Cells(ActiveCell.Row, 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.RowHeight = 300
    Cells(ActiveCell.Row, 1).Select
     Application.CutCopyMode = False
    End If
    [a1].Select
    ActiveWindow.ScrollRow = Selection.Row
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End If
End Sub

Action
1 - Pour démarrer le test, clic sur le bouton "supprime formats" (supprime les formats des lignes (sauf ligne 6),
2 - Pour afficher en clair et en couleur les lignes clic dans une cellule de la ligne choisie pour affichage,

Mon besoin
Je voudrais mettre en cellule :
1 - en cellule "M5" le temps pendant lequel je suis resté sur la ligne affichée
2 - en cellule "M4" le temps "cumulé" pendant lequel je suis resté sur toutes les lignes

Auriez-vous le bon code ?

Je joins un p'tit fichier test et je continue mes recherches,
Un grand merci,
lionel :)
 

Pièces jointes

  • affichage_temps.xlsm
    33 KB · Affichages: 10
Dernière édition:
Solution
En déclarant la ligne cliquée en Public pour la mémoriser puis avec :
VB:
    If LigneCliquée <> R.Row Then T0 = Timer
et
   If R.Row <> LigneCliquée Then
        LigneCliquée = R.Row
        Tpassé = (Timer - T0) / 86400
        [M5] = Tpassé
        [M4] = [M4] + Tpassé
    End If

TooFatBoy

XLDnaute Barbatruc
Dans tes recherches, tu as dû rencontrer le mot "timer", je suppose.
C'est peut-être une solution à envisager.

Sinon, simplement mettre l'heure dans une variable au moment adéquat, c'est-à-dire à l'activation de la ligne à chrométrer, et faire la différence avec l'heure au moment de sa désactivation.


[edit]
Mon premier message est parti un peu vite... et tu as répondu pendant que j'écrivais ce complément.
[/edit]
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
rebonjour Lionel, Marcel,
Un essai en PJ avec :
VB:
En début de macro :
    T0 = Timer

A la fin :
    [M5] = 1000 * (Timer - T0)
    [M4] = [M5] + [M4]
Les temps sont affichés en ms.

Comme M4 s'auto-incrémente, il faut l'initialiser, donc en ThisWorkbook j'ai mis :
Code:
Private Sub Workbook_Open()
     [M4] = 0: [M5] = 0
End Sub
 

Pièces jointes

  • affichage_temps.xlsm
    32.2 KB · Affichages: 2

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour sylvanu, Merci d'être encore là pour moi :)
Et merci pour ton fichier ... ça fonctionne nickel :)

J'ai 2 demandes pour ce soit "Perfect" pour mettre dans mes "usines à gazouillis" lol
1 - Est-il possible de formater M4 et M5 en heures, minutes, secondes et millisecondes ?
(c'est pour totaliser les temps de travail de la journée)

2 - Le code va être utilisé dans mon fichier de travail qui a plusieurs feuilles. Est-il possible que le code soit fonctionnel en étant dans le code de la feuille où il sera utilisé (Test pour ce fichier) ?
(au lieu d'être dans le ThisWorkbook)

Déjà nickel, un grand merci à toi :)
lionel,
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
1- Il suffit de faire à la fin :
VB:
    Tpassé = (Timer - T0) / 86400
    [M5] = Tpassé
    [M4] = [M4] + Tpassé
et mettre les temps en format : hh:mm:ss.000
2-
(au lieu d'être dans le ThisWorkbook)
Dans Thisworkbook il n'y a rien si ce n'est à remise à zéro du temps en M4.
Comme se temps s'incrémente, il faut bien qu'au départ il soit à 0.
 

Pièces jointes

  • affichage_temps.xlsm
    32.6 KB · Affichages: 4

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re-sylvanu :)

Encore MERCI,
Effectivement, j'ai regardé trop vite le ThisWorkbook et merci pour le format des cellules.

J'en ai une petite dernière lol (enfin je crois 😇)
Dans le cadre du travail, on peut estimer que le temps que je reste sur une ligne est le temps de travail sur cette ligne.

Mais, si je clique sur une autre cellule de la même ligne (ligne active) le code se répète.
Il faudrait que le code s'active uniquement quand je change de ligne .... C'est possible Docteur ?
lionel :)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
En déclarant la ligne cliquée en Public pour la mémoriser puis avec :
VB:
    If LigneCliquée <> R.Row Then T0 = Timer
et
   If R.Row <> LigneCliquée Then
        LigneCliquée = R.Row
        Tpassé = (Timer - T0) / 86400
        [M5] = Tpassé
        [M4] = [M4] + Tpassé
    End If
 

Pièces jointes

  • affichage_temps (1).xlsm
    32.3 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bonjour Lionel, Marcel32, sylvanu,

Je trouve le fichier du post #1 trop tarabiscoté, j'en ai donc fait un autre :
VB:
Dim marche As Boolean 'mémorise la variable

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a$, h#, t#, tt#
If Intersect(ActiveCell, [B5:B9]) Is Nothing Then marche = False: Exit Sub
marche = True
a = ActiveCell.Address
h = ActiveCell
t = Timer
While marche And ActiveCell.Address = a
    If Timer < t Then h = ActiveCell: t = Timer 'après minuit
    ActiveCell = h + (Timer - t) / 86400
    tt = Timer + 0.1
    While Timer < tt And tt < 86400: DoEvents: Wend 'attente de 0.1 seconde
Wend
End Sub

Sub RAZ()
marche = False
[B5:B9] = ""
End Sub
A+
 

Pièces jointes

  • Timer(1).xlsm
    18.3 KB · Affichages: 3

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Belle fin de dimanche :)

Je reviens sur le fil car c'est un peu plus compliqué que je ne pensais lol .... ça aurait été trop simple.
Le souci sur le code de Sylvanu (qui par ailleurs fonctionne très bien :)) est :
1- Pas de comptage du temps passé sur la ligne,

Le souci du code de Gérard (qui par ailleurs fonctionne très bien dans son contexte, et que je garde précieusement :)) :
- Ne correspondant pas au besoin de mon fichier.

L'idéal serait, dans le contexte de mon fichier joint, d'intégrer le code de Gérard.
C'est ce que je tente de faire ... sans succès pour l'instant ...

Un p'tit peu d'aide ?
Entre temps, je continue d'essayer ...
Merci d'avance :)
Je joins le fichier contenant les 2 codes.
lionel :)
 

Pièces jointes

  • affichage_temps_2.xlsm
    40.7 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour Lionel, le fil,

Le fichier du post #1 ne va pas, c'est pour ça que je ne l'ai pas utilisé.

Il n'est pas normal que ta macro s'exécute sur les lignes > 10, il faut la revoir.

Tu devrais être capable d'adapter mes codes à ce que tu veux faire.

A+
 

Discussions similaires

Réponses
8
Affichages
472

Statistiques des forums

Discussions
312 104
Messages
2 085 339
Membres
102 865
dernier inscrit
FreyaSalander