Discussion :

[xaviermagdelaine]

Bonjour,
J'ai un fichier dans lequel j'effectue le suivi de prêt d'outil à des personnes qui doivent les restituer sous les 18H.
Lorsque la personne emprunte, je flashe son nom et ensuite une macro enregistre le mouvement dans un onglet historique.
J'aimerais une macro afin que Si la personne n'a pas restitué l'outil avant les 18H (durée de l'emprunt maxi) par rapport à la date en colonne D cela s'enregistrer la ligne complète dans l'onglet "Retard".
Merci par avance pour votre aide.

[unparia]

Bonjour
Tu ferais sans doute mieux d'exposer ici techniquement (en nous parlant de cellules) complètement ton problème , accompagné de ton code d'essai.
Lire :
https://www.developpez.net/forums/d8...s-discussions/
Je n'ouvre personnellement jamais un classeur tiers

[xaviermagdelaine]

Bonjour, Je vais tenté de vous expliquer plus clairement non besoin sans le fichier.
J'ai fichier "pret" avec 3 onglets.
Chaque onglet
-TamponM2
-HistoriquePrêt
-Retard
est composé de 5 colonnes
-Désignation
-Réf
-Nom
-Date (avec heure)
-Statut( ex.emprunté)
Dans l'onglet TamponM2 plusieurs lignes avec différents outils
ex:
-Ligne 1 tampon M2 4.15
-Ligne 2 tampon M2 4.8
-Ligne 3 tampon M2 5.6
lorsqu'une personne emprunter le tampon M2 5.6, je flasche son non en L3 colonne C ensuite ce mouvement est enregistrer dans l'onglet Historique.
Sur l'onglet TamponM2 cela indique le nom de la personne en L3 colonne C et la date avec heure en D3.
J'aimerais une macro pour remplir automatiquement l'onglet "Retard" si cette personne n'a pas restitué l'outil dans les 18Heures de son prêt par rapport à la date en D3 (onglet TamponM2).
Voici une partie du code qui existe déjà.

La deuxième partie semble ne pas fonctionner (partie "retard"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("C3:C50")) Is Nothing Then
        Cancel = True
        'Récupération des données de la ligne choisie
        xDesigna = Cells(Target.Row, "A")
        xReferen = Cells(Target.Row, "B")
        xNomAjus = Cells(Target.Row, "C")
        xDatePre = Cells(Target.Row, "D")
        xManquan = Cells(Target.Row, "F")
        xStatut = Cells(Target.Row, "E")
        'Test si un ajusteur est déja indiqué
        If xNomAjus <> Empty Then
            xMess = Empty
            xMess = xMess & "L'ajusteur  " & xNomAjus & "  est déjà indiqué" & Chr(13)
            xMess = xMess & "Cela veut-il dire qu'il à rendu le matériel" & Chr(13) & Chr(13)
            xMess = xMess & " - Si OUI, matériel rendu, donc effacement des données" & Chr(13)
            xMess = xMess & " - Si NON, erreur de ligne" & Chr(13)
            xRep = MsgBox(xMess, vbQuestion + vbYesNo, "TOTO")
            If xRep = vbYes Then
                Cells(Target.Row, "C") = Empty
                Cells(Target.Row, "D") = Empty
                xStatut = "Rendu"
                Cells(Target.Row, "E") = ""
                GoTo EnregistreHistorique
            Else
                Exit Sub
            End If
        Else
            xNomAjus = InputBox("Nom de l'ajusteur", "AJUSTEUR")
            Cells(Target.Row, "C") = xNomAjus
            Cells(Target.Row, "D") = Now
            xDatePre = Cells(Target.Row, "D")
            xStatut = "Emprunté"
            Cells(Target.Row, "E") = xStatut
        End If
EnregistreHistorique:
        With Sheets("HistoriquePrêt")
            xDerLig = .Range("A65536").End(xlUp).Row
            xNewlig = xDerLig + 1
            .Cells(xNewlig, "A") = xDesigna             'Désignation
            .Cells(xNewlig, "B") = xReferen             'Référence
            .Cells(xNewlig, "C") = xNomAjus             'Nom ajusteur
            .Cells(xNewlig, "D") = Now                  'Date pret
            .Cells(xNewlig, "F") = xManquan             'Manquant
            .Cells(xNewlig, "E") = xStatut              'Statut
        End With
    End If
End Sub
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Sheets("Retard").Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
 
For Each Cel In Range("D3:D" & Range("D" & Rows.Count).End(xlUp).Row)
    If Cel.Value <> "" Then
        r = Cel.Row
        If Cells(r, "E").Value = "Emprunté" Then
        late = Now - Cel.Value
        If late > 0.02 Then
            Rows(r).EntireRow.Copy
            derlig = Sheets("Retard").Range("A" & Rows.Count).End(xlUp).Row + 1
            Sheets("Retard").Range("A" & derlig).PasteSpecial xlPasteValues
        End If
        End If
    End If
Next Cel
 
Application.CutCopyMode = False
 
End Sub

Je pense avoir été complet dans mes explication et reste à votre dispo pour explications supplémentaire.
Merci.

[Docmarti]

Bonjour.

2 modifications:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Retard").Range("A2:E" & Sheets("Retard").Range("A" & Rows.Count).End(xlUp).Row).ClearContents

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If late > CDate("18:00") Then

[xaviermagdelaine]

Bonjour,
Je te remercie Docmarti d'avoir pris du temps pour m'aider.
J'ai testé le code après avoir corrigé les deux erreurs et cela me fonctionne pas.
Merci

[unparia]

Bonjour
Je lis ceci dans ton code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(Target.Row, "D") = Now

donc ta colonne D contient des Datetime.
puis ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
late = Now - Cel.Value
If late > 0.02 Then

que je compare à cela :

si cette personne n'a pas restitué l'outil dans les 18Heures de son prêt par rapport à la date en D3

Heu ... depuis quand une différence de 0.02 entre deux DateTime représente-t-elle 18 heures ?
J'aurais à ta place au moins eu le réflexe de tester ceci, sur une feuille vierge :

un bouton de commande et :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Range("A1").value = Now
Range("B1").value = Range("A1").value + 0.02

et aurais regardé A1 et B1 et constaté que 0.02 ne font pas 18 heures. J'en aurais déduit que mon calcul d'écart est erroné, non ?
Intéresse-toi vite à la fonction Datediff, s'il te plait ...

[Docmarti]

J'ai testé le code après avoir corrigé les deux erreurs et cela me fonctionne pas.
Merci

Quel est ton code actuel ?