Bug en sortie de formulaire

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

Bonjour et bienvenue,

Le fichier n'est pas passé !

Claude

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

Rechercher des sujets similaires à "bug sortie formulaire"