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 : 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
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
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

TimbreuseCompta.xlsm