Liste déroulante vide
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
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
Dernière modification par Philippe JOCHMANS ; Aujourd'hui
Bonjour
Il manque le principal .... ton fichier.
Amicalement
Nad
Bonjour Nad-Dan
Comment faut il faire pour joindre un fichier de plus de 120ko
Merci
Re
En 1er essaye en le zippant.
Si toujours trop lourd, tu peux passer par cjoint.com
Amicalement
Nad
Bonjour,
Tu peux le mettre en format .zip par exemple.
merci pour vos réponses rapides mais comment faut il faire pour initialiser la liste d'une part et d'autre part je viens de m'apercevoir que si tu saisie 2 fois le même utilisateur à des heures différentes il supprime toujours le premier.
Pensez vous que je puisse utiliser le même userform que la (recherche automatique) mais pour la suppression. Dans ce cas la comment faut il faire??
merci de votre aide