liste déroulante vide

**pat17** · 30/03/2010, 08h55

Bonjour à tous,
Je progresse doucement grace à votre concours.
Ce matin j'ai un probleme avec une liste déroulante qui est vide

Quand je clique sur le bouton (supprimer une réservation) la liste date est vide.
Pouvez vous m'aider?

voici le code

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Private LigneDeDate
Private compteurFeuille
Private ColonneDuNom
Private compteurDeColonneDuJour
Private Sub CmBAnnuler_Click()
    Unload Me
End Sub
 
 
 
Private Sub ComboDate_Change()
    ComboDate = CDate(ComboDate)
End Sub
 
Private Sub UserForm_Initialize()
    Dim Cell As Range
    With Sheets("FeuilleDeTravail")
        For Each Cell In .Range("J2:J" & .Range("J65536").End(xlUp).Row)
        ComboNom.AddItem (Cell)
        Next
    End With
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Unload Me
End Sub
 
 
Private Sub CmbValider_Click()
    If ComboNom = "" Then
        MsgBox " le nom de l'utilisateur n'est pas documenté "
        Exit Sub
    End If
    If ComboDate = "" Then
       MsgBox " la date de réservation n'est pas documentée "
       Exit Sub
    End If
   For compteurFeuille = 1 To Worksheets.Count
        If Sheets(compteurFeuille).Name <> "Menu" And Sheets(compteurFeuille).Name <> "FeuilleDeTravail" And Sheets(compteurFeuille).Name <> "Cadre" Then
            'MsgBox Sheets(compteurFeuille).Name
 
            LigneDeDate = Application.WorksheetFunction _
                 .Match(CLng(CDate(ComboDate)), Worksheets(compteurFeuille).Range("A1:A368"), 0)
 
            On Error GoTo GestionDesErreurs
            ColonneDuNom = Application.WorksheetFunction _
                 .Match(ComboNom, Worksheets(compteurFeuille).Range("B" & LigneDeDate & ":Y" & LigneDeDate), 0)
            On Error GoTo 0
 
            ' effacement des resa jours précédents
            If ColonneDuNom = 1 And Worksheets(compteurFeuille).Cells(LigneDeDate - 1, 25).Interior.ColorIndex = 35 Then
            EffacementRésaJourAvant
            End If
           ' Effacement de la résa du jour
           EffacementResaDuJour
           If compteurDeColonneDuJour = 25 Then
           EffacementResaDesJoursAprès
           End If
           MsgBox "Suppression effectué pour M: " & ComboNom & " pour la date du : " & CDate(ComboDate) & " pour l'objet : " & Sheets(compteurFeuille).Name
           Unload Me
           Exit Sub
Autre:
        End If
    Next
    MsgBox " pas de réservation trouvée en date du : " & CDate(ComboDate) & " pour M : " & ComboNom & " ."
    Unload Me
GestionDesErreurs:
    If Err = 1004 Then
       Err = 0
       Resume Autre
    End If
End Sub
Sub EffacementRésaJourAvant()
      Dim compteurDeColonne As Byte
      Dim LigneAAnalyser As Integer
        With Sheets(compteurFeuille)
            For LigneAAnalyser = LigneDeDate - 1 To 4 Step -1
                compteurDeColonne = 25
                Do Until compteurDeColonne = 1
                    If .Cells(LigneAAnalyser, compteurDeColonne).Interior.ColorIndex <> 35 Then
                        Exit Sub
                    End If
                    If .Cells(LigneAAnalyser, compteurDeColonne) <> "" Then
 
                        If .Cells(LigneAAnalyser, compteurDeColonne) <> ComboNom Then
                        Exit Sub
                        ElseIf .Cells(LigneAAnalyser, compteurDeColonne) = ComboNom Then
                        Range(.Cells(LigneAAnalyser, compteurDeColonne), .Cells(LigneAAnalyser, 25)).Clear
                            If compteurDeColonne > 2 Then
                            Exit Sub
                            End If
                        End If
                    End If
                compteurDeColonne = compteurDeColonne - 1
                Loop
            Next
        End With
End Sub
Sub EffacementResaDuJour()
         With Sheets(compteurFeuille)
            For compteurDeColonneDuJour = ColonneDuNom + 1 To 25
                If .Cells(LigneDeDate, compteurDeColonneDuJour).Borders(xlEdgeRight).LineStyle = xlContinuous Then
                    Range(.Cells(LigneDeDate, ColonneDuNom + 1), .Cells(LigneDeDate, compteurDeColonneDuJour)).Clear
                    Exit Sub
                End If
            Next
 
         End With
End Sub
Sub EffacementResaDesJoursAprès()
      Dim compteurDeColonne As Byte
      Dim LigneAAnalyser As Integer
        With Sheets(compteurFeuille)
            For LigneAAnalyser = LigneDeDate + 1 To 368 Step 1
                compteurDeColonne = 2
                    If .Cells(LigneAAnalyser, compteurDeColonne).Interior.ColorIndex <> 35 Then
                        Exit Sub
                    End If
                    If .Cells(LigneAAnalyser, compteurDeColonne) <> "" Then
                        If .Cells(LigneAAnalyser, compteurDeColonne) <> ComboNom Then
                            Exit Sub
                        ElseIf .Cells(LigneAAnalyser, compteurDeColonne) = ComboNom Then
                            Do Until compteurDeColonne = 26
                                If .Cells(LigneAAnalyser, compteurDeColonne).Borders(xlEdgeRight).LineStyle = xlContinuous Then
                                    Range(.Cells(LigneAAnalyser, 2), .Cells(LigneAAnalyser, compteurDeColonne)).Clear
                                End If
                            compteurDeColonne = compteurDeColonne + 1
                            Loop
                            If compteurDeColonne < 25 Then
                                Exit Sub
                            End If
                        End If
                    End If
 
            Next
        End With
End Sub