Bonjour à tous,
Je bloque sur la fonction Application.WorksheetFunction.CountIf qui est censée rechercher dans la colonne F les dates supérieures à la date d'ouverture du fichier.
A chaque modification sur une ligne (via un UF) je rentre la date de modification.
Countif est censée me permettre de recencer les dates supérieures à la date d'ouverture du fichier afin de les extraires et les envoyer par mail.
J'ai réussi à le coder sur un PC mais lorsque j'ai mis le fichier sur un autre PC (qui est celui sur lequel le fichier sera explouité) la fonction CountIf ne fonctionne plus.
J'en appel à vous pour m'indiquer comment rédiger la procédure pour qu'elle fonctionne sur tous les PC.
Je ne peux pas vous envoyer le fichier mais voici le code utilisé :
J'ai lu que cela pouvait être causé par la codifaction anglosaxone des dates et j'ai essayé plusieurs combinaisons en mettant now en cdate, ou cdbl ou même CDbl(CDate(now)) mais je n'y arrive pas.
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 Public TimeOuv as Date Public ws As Worksheet Public cte, btm Private Sub Workbook_Open() ' Enregistre la date et l'heure d'ouverture du fichier TimeOuv = now End Sub Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Sh.Name <> "Feuil1" Then Exit Sub If Not Intersect(Target, Range(Cells(2, 1), Cells(Cells(2, 2).End(xlDown).Row, 1))) Is Nothing Then Cancel = True If LCase(Target.Value) = "x" Then Target.Value = "" Else Target.Value = "x" End If Target.Offset(0, 5) = now ' C'est ici que j'enregistre la date et l'heure de modification de ma ligne en colonne F End If End If End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) Set ws = Worksheets("Feuil1") btm = ws.Cells(Rows.Count, 3).End(xlUp).Row cte = Application.WorksheetFunction.CountIf(ws.Range("F2:F" & btm), ">" & TimeOuv) ' C'est la partie qui ne fonctionne pas, ou je cherche dans la colonne F toute les dates supérieures à la date d'ouverture If cte > 0 Then Envoie_mail End Sub
J'attends vos recommandations.
Partager