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):
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 : 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 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:
Je met le .xlsm en pièce jointe (Tout le code est dans les module1 pour la timbreuse et module2 pour la facturation)
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 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
Bref je suis très confus et serai très content si quelqu'un pouvait m'apporter son aide siouplait
TimbreuseCompta.xlsm
Partager