1 pièce(s) jointe(s)
VBA FIND Date in Range -> Nothing aléatoire
Bonjour,
Actuellement très désespérer car je me retrouve dans une situation vraiment très aléatoire ! Je m'explique :
J'ai créé un fichier Excel xlsm qui fait le travaille d'une timbreuse (horaires de travail) mais il permet aussi de gérer la partie "Facturation" de l'affaire et c'est là que les choses deviennent compliquées.
Il y a deux listes déroulantes, une qui me permet de choisir la date de début et la seconde la date de fin. Pour chaque timbrage il y a donc deux dates. Quand je choisie dans la première liste une date, la seconde liste doit se mettre à jour et ne me donner que les dates plus récentes que la date sélectionné dans la première liste. Je n'ai aucun problème avec la méthode FIND dans ce cas (Sélection du nom de l'employé pour le timbrage):
Code:
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
| With ActiveSheet.Shapes("ZoneCombineEmploye").ControlFormat
If Not .List(.ListIndex) = "" Then
strNomEmploye = .List(.ListIndex)
Worksheets("Données Brutes").Activate
With Worksheets("Données Brutes").Range("A1", "A1000000")
Set c = .Find(strNomEmploye, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If Not c.Offset(0, 3).Value = "" And Not c.Offset(0, 4).Value = "" Then
strEtatEmploye = "Disponible, actuellement sans tâche !"
Else
strEtatEmploye = "Employé(e) " & strNomEmploye & " assigné à " & c.Offset(0, 1).Value & vbCrLf & "Tâche : " & c.Offset(0, 2).Value _
& vbCrLf & "Début : " & Format(c.Offset(0, 3).Value, "le dddd d mmmm yyyy à hh\h mm\m") & vbCrLf & "Temps actuel : " & _
Round(DateDiff("n", c.Offset(0, 3).Value, Now, vbMonday, vbFirstJan1) / 60, 2) & " h"
Exit Do
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Worksheets("Timbreuse").Activate
MsgBox strEtatEmploye, vbInformation, "État d'assignation concernant " & strNomEmploye
Else
MsgBox "Aucun(e) employé(e) sélectionné(e) !", vbExclamation, "Informations incomplètes"
End If
End With |
Mais j'ai un gros soucis avec la méthode FIND dans le cas ci-dessous car elle ne me trouve qu'une fois sur deux la date envoyé et parfois ça ne fonctionne tout simplement plus ... :? :
Code:
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
| Sub ZoneCombineFacturePeriodeDebut_QuandChangement()
strRangePeriodeFin = ""
iNbLignesPeriodeFin = 0
Worksheets("Facturation").Activate
'Application.ScreenUpdating = False
'Récupération de la date de début depuis la "Zone Combine"
With ActiveSheet.Shapes("ZoneCombineFacturePeriodeDebut").ControlFormat
If Not .List(.ListIndex) = "" Then
strDatePeriodeDebut = .List(.ListIndex)
'Recherche de la première date de fin plus veille que la date début
Worksheets("FacturationEnCours").Activate
Range("D1").Select
With Worksheets("FacturationEnCours").Range("D1", "D1000000")
Set c = .Find(what:=DateValue(strDatePeriodeDebut), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
strRangePeriodeFin = c.Address
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Range(strRangePeriodeFin).Select
If Not Range(Selection.Address).Offset(1, 0) = "" Then
strRangePeriodeFin = Range(strRangePeriodeFin, Selection.End(xlDown)).Address
iNbLignesPeriodeFin = Range(strRangePeriodeFin).Rows.Count
Else
iNbLignesPeriodeDebut = 1
End If
'Assignation de la range de date de fin dans la "Zone Combine"
Worksheets("Facturation").Activate
With ActiveSheet.Shapes("ZoneCombineFacturePeriodeFin").ControlFormat
.ListFillRange = "'FacturationEnCours'!" & strRangePeriodeFin
.DropDownLines = iNbLignesPeriodeFin
End With
Application.ScreenUpdating = True
End If
End With
End Sub |
Je met le .xlsm en pièce jointe (Tout le code est dans les module1 pour la timbreuse et module2 pour la facturation)
Bref je suis très confus et serai très content si quelqu'un pouvait m'apporter son aide siouplait :D
:triste:Pièce jointe 413837
