Bug en sortie de formulaire
p
Bonjour à tous,
Je sollicite votre expérience car je n'arrive pas à régler un petit problème.
En cliquant sur (recherche automatique) j'arrive bien à renseigner les données mais lorsque je clique sur (lancer la recherche) j'ai une "erreur 1004 impossible de lire la propriété match de la classe worksheet function"
merci de votre aide
d
duboisPassionné d'Excel
- Messages
- 9'245
- Excel
- Vista Office 2007FR
- Inscrit
- 08/12/2007
- Emploi
- retraité Sce.Méthodes
Bonjour et bienvenue,
Le fichier n'est pas passé !
Claude
p
Merci de votre réponse et peux être que le code sera plus explicite
Private HeureDeDébut
Private HeureDeFin
Private LigneDeDateDébut
Private ColonneDébut
Private LigneDeDatefin
Private ColonneFin
Public CelluleAEntourer
Private Sub CmBAnnuler_Click()
Unload Me
End Sub
Private Sub CmbValider_Click()
If ComboNomUtilisateur = "" Then
MsgBox " le nom de l'utilisateur n'est pas documenté "
Exit Sub
End If
If ComboDateDébut = "" Then
MsgBox " la date de début de réservation n'est pas documentée "
Exit Sub
End If
If ComboHeureDébut = "" Then
MsgBox " l'heure de début de réservation n'est pas documentée "
Exit Sub
End If
If ComboDateFin = "" Then
MsgBox " la date de fin de réservation n'est pas documentée "
Exit Sub
End If
If ComboHeureFin = "" Then
MsgBox " l'heure de fin de réservation n'est pas documentée "
Exit Sub
End If
If CDate(ComboDateDébut) > CDate(ComboDateFin) Then
MsgBox " la date de fin de réservation ne peut pas ètre inférieure à celle de début"
Exit Sub
End If
If CDate(ComboDateDébut) = CDate(ComboDateFin) And CDate(HeureDeDébut) >= CDate(HeureDeFin) Then
MsgBox " Si la réservation est d'une journée ,l'heure de début de réservation ne peut pas ètre inférieure ou égale à celle de fin de réservation "
Exit Sub
End If
If CDate(ComboDateFin) > CDate(ComboDateDébut) + Range("FeuilleDeTravail!A2") Then
MsgBox " la durée de réservation ne peut excéder " & Range("FeuilleDeTravail!A2") & " jours. "
Exit Sub
End If
ListBoxVh.Clear
For compteurFeuille = 1 To Worksheets.Count
If Worksheets(compteurFeuille).Name <> "FeuilleDeTravail" And Worksheets(compteurFeuille).Name <> "Menu" And Worksheets(compteurFeuille).Name <> "Cadre" Then
With Worksheets(compteurFeuille)
LigneDeDateDébut = Application.WorksheetFunction _
.Match(CLng(CDate(ComboDateDébut)), Worksheets(compteurFeuille).Range("A1:A368"), 0)
ColonneDébut = Application.WorksheetFunction _
.Match(CDate(HeureDeDébut), Worksheets(compteurFeuille).Range("A3:Y3"), 1)
LigneDeDatefin = Application.WorksheetFunction _
.Match(CLng(CDate(ComboDateFin)), Worksheets(compteurFeuille).Range("A1:A368"), 0)
ColonneFin = Application.WorksheetFunction _
.Match(CDate(HeureDeFin), Worksheets(compteurFeuille).Range("A3:Y3"), 1)
If CDate(ComboDateDébut) = CDate(ComboDateFin) Then
For compteurDeColonne = ColonneDébut To ColonneFin
If .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
ListBoxVh.AddItem (Worksheets(compteurFeuille).Name)
GoTo VhLibre
ElseIf CDate(ComboDateFin) = CDate(ComboDateDébut) + 1 Then
For compteurDeColonne = ColonneDébut To 25
If .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
For compteurDeColonne = 2 To ColonneFin
If .Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
ListBoxVh.AddItem (Worksheets(compteurFeuille).Name)
GoTo VhLibre
ElseIf CDate(ComboDateFin) - CDate(ComboDateDébut) > 1 Then
For compteurDeColonne = ColonneDébut To 25
If .Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
For CompteurDeLigne = 1 To (CDate(ComboDateFin) - CDate(ComboDateDébut) - 1)
For compteurDeColonne = 2 To 25
If .Cells(LigneDeDateDébut + CompteurDeLigne, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
Next
For compteurDeColonne = 2 To ColonneFin
If .Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex <> xlNone Then
GoTo VhLibre
End If
Next
ListBoxVh.AddItem (Worksheets(compteurFeuille).Name)
GoTo VhLibre
End If
End With
End If
VhLibre:
Next
If ListBoxVh.ListCount = 0 Then
MsgBox "Pas de disponibilité"
Exit Sub
Else
ListBoxVh.Visible = True
LbReservation.Visible = True
LbInfo.Visible = True
ListBoxVh.SetFocus
End If
End Sub
Private Sub ComboNomUtilisateur_Change()
Application.EnableEvents = False
With Sheets("FeuilleDeTravail")
NombreDeLigne = 2
Do Until .Cells(NombreDeLigne, 10) = ""
If CStr(.Cells(NombreDeLigne, 10)) = CStr(ComboNomUtilisateur.Value) Then
ComboNomUtilisateur.Value = .Cells(NombreDeLigne, 10)
Application.EnableEvents = True
Exit Sub
End If
NombreDeLigne = NombreDeLigne + 1
Loop
End With
Application.EnableEvents = True
End Sub
Private Sub LbInfo_Click()
End Sub
Private Sub ListBoxVh_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ComboNomUtilisateur.ListIndex = -1 Then
InsérerNomDansLaBase
End If
With Worksheets(ListBoxVh.Value)
If CDate(ComboDateDébut) = CDate(ComboDateFin) Then
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
For compteurDeColonne = ColonneDébut To ColonneFin
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
ElseIf CDate(ComboDateFin) = CDate(ComboDateDébut) + 1 Then
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
For compteurDeColonne = ColonneDébut To 25
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
For compteurDeColonne = 2 To ColonneFin - 1
.Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
Contour
ElseIf CDate(ComboDateFin) > CDate(ComboDateDébut) + 1 Then
For compteurDeColonne = ColonneDébut To 25
.Cells(LigneDeDateDébut, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDateDébut, ColonneDébut) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut, ColonneDébut), .Cells(LigneDeDateDébut, compteurDeColonne - 1)).Address
Contour
For CompteurDeLigne = 1 To (CDate(ComboDateFin) - CDate(ComboDateDébut) - 1)
For compteurDeColonne = 2 To 25
.Cells(LigneDeDateDébut + CompteurDeLigne, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDateDébut + CompteurDeLigne, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut + CompteurDeLigne, 2), .Cells(LigneDeDateDébut + CompteurDeLigne, 25)).Address
Contour
Next
.Cells(LigneDeDateDébut + 1, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDateDébut + 1, 2), .Cells(LigneDeDateDébut + 1, 25)).Address
Contour
For compteurDeColonne = 2 To ColonneFin
.Cells(LigneDeDatefin, compteurDeColonne).Interior.ColorIndex = 35
Next
.Cells(LigneDeDatefin, 2) = ComboNomUtilisateur
CelluleAEntourer = Range(.Cells(LigneDeDatefin, 2), .Cells(LigneDeDatefin, compteurDeColonne - 1)).Address
Contour
End If
End With
Unload Me
MsgBox " Réservation effectuée"
End Sub
Private Sub ComboDateDébut_Change()
ComboDateDébut = CDate(ComboDateDébut)
End Sub
Private Sub ComboDateFin_Change()
ComboDateFin = CDate(ComboDateFin)
End Sub
Private Sub ComboHeureDébut_Change()
HeureDeDébut = ComboHeureDébut
ComboHeureDeDébut = Format(CDate(ComboHeureDeDébut), "hh:mm")
End Sub
Private Sub ComboHeureFin_Change()
HeureDeFin = ComboHeureFin
ComboHeureFin = Format(CDate(ComboHeureFin), "hh:mm")
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)
ComboNomUtilisateur.AddItem (Cell)
Next
End With
With Sheets("FeuilleDeTravail")
For Each Cell In .Range("G2:G" & .Range("G65536").End(xlUp).Row)
ComboDateDébut.AddItem (Cell)
Next
End With
With Sheets("FeuilleDeTravail")
For Each Cell In .Range("G2:G" & .Range("G65536").End(xlUp).Row)
ComboDateFin.AddItem (Cell)
Next
End With
With Sheets("FeuilleDeTravail")
For Each Cell In .Range("H2:H" & .Range("H65536").End(xlUp).Row)
ComboHeureDébut.AddItem Format((Cell), "hh:mm")
Next
End With
With Sheets("FeuilleDeTravail")
For Each Cell In .Range("H2:H" & .Range("H65536").End(xlUp).Row)
ComboHeureFin.AddItem Format((Cell), "hh:mm")
Next
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Unload Me
End Sub
Sub Contour()
With Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Worksheets(ListBoxVh.Value).Range(CelluleAEntourer).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
Sub InsérerNomDansLaBase()
Application.ScreenUpdating = False
Réponse = MsgBox(" l'utilisateur : " & ComboNomUtilisateur & " n'existe pas dans la base des utilisateurs habituels, voulez vous l'insérer", vbYesNo)
If Réponse = vbYes Then
Sheets("FeuilleDeTravail").Activate
Range("J" & Range("J65536").End(xlUp).Row + 1) = ComboNomUtilisateur
Range("J2:J" & Range("J65536").End(xlUp).Row).Select
Selection.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Sheets("Menu").Activate
End Sub-- 29 Mar 2010, 16:16 --
problème résolu
merci à tous