Tranche horaire dans planning

Le 28/09/2010 à 12:35

Bonjour le forum,

J'ai un problème avec mon planning pour réserver sur 30 minutes et je ne trouve pas la solution.

J'ai une erreur d'execution 5,argument ou appel de procédure incorrect.

ci joint le code

Option Explicit
Private MaPlage As Range
Private CouleurUser As Integer
Dim Lig As Long, LigDeb As Long, LigFin As Long, Col As Integer, ColDebH As Integer, ColFinH As Long, IndCol As Integer

Private Sub CmBAnnuler_Click()
  Unload Me
End Sub

Private Sub CmbValider_Click()
'Tester si tous les combo sont rempli avant d'appeler la fonction
  If Me.ComboNomUtilisateur.Value = "" Then
    Me.ComboNomUtilisateur.SetFocus
    MsgBox "Merci de remplir le nom de l'utilisateur !"
    Exit Sub
  End If
  If Me.ComboDateDébut.Value = "" Then
    Me.ComboDateDébut.SetFocus
    MsgBox "Merci de remplir la date de début !"
    Exit Sub
  End If
  If Me.ComboDateFin.Value = "" Then
    Me.ComboDateFin.SetFocus
    MsgBox "Merci de remplir la date de fin !"
    Exit Sub
  End If
  If Me.ComboHeureDébut.Value = "" Then
    Me.ComboHeureDébut.SetFocus
    MsgBox "Merci de remplir l'heure de debut !"
    Exit Sub
  End If
  If Me.ComboHeureFin.Value = "" Then
    Me.ComboHeureFin.SetFocus
    MsgBox "Merci de remplir l'heure de fin !"
    Exit Sub
  End If
  ' Appeler la fonction
  If ValidationReservation(Me.ComboNomUtilisateur, Me.ComboDateDébut, Me.ComboHeureDébut, Me.ComboDateFin, Me.ComboHeureFin) Then
    Me.ListBoxVh.Visible = True
    Me.LbInfo.Visible = True
    Me.LbReservation.Visible = True
  Else
    MsgBox "Aucune réservation n'est possible dans cette plage horaire"
    Me.ListBoxVh.Visible = False
    Me.LbInfo.Visible = False
    Me.LbReservation.Visible = False
    Exit Sub
  End If
End Sub

Public Function ValidationReservation(Nom As String, MaDateDeb As Date, HeureDebut As Date, MaDateFin As Date, HeureFin As Date) As Boolean
  Dim MaFeuille As Worksheet, TabF As String
  Dim IsLibre As Boolean

  ' Remplissage du tableau des feuilles à ne pas prendre en compte
TabF = "Jours ouvrés;Menu;Data;Params;Cadre;Impression"
  '
' Calcul de la ligne de date de DEBUT
LigDeb = 3 + DatePart("y", MaDateDeb)
  LigFin = 3 + DatePart("y", MaDateFin)
  '
' Calcul la colonne d'heure DEBUT
ColDebH = Me.ComboHeureDébut.ListIndex + 2
  '
' Calcul la colonne d'heure FIN
ColFinH = Me.ComboHeureFin.ListIndex + 1
  '
' Vider la listbox de choix
Me.ListBoxVh.Clear
  ' Pour chaque feuille du classeur
For Each MaFeuille In Worksheets
    IsLibre = True  ' Mettre la variable à VRAI ici
  ' Si c'est une feuille de planning
  If InStr(1, TabF, MaFeuille.Name, vbTextCompare) = 0 Then
      ' Pour chaque ligne de réservation
    For Lig = LigDeb To LigFin
        ' Pour chaque colonne
      For Col = ColDebH To ColFinH
          ' Si la cellule n'est pas vide
        If MaFeuille.Cells(Lig, Col).Value <> "" Or MaFeuille.Cells(Lig, Col).MergeCells Then
            IsLibre = False
            Exit For
          End If
        Next Col
      Next Lig
      ' La réservation est-elle possible
    If IsLibre Then Me.ListBoxVh.AddItem (MaFeuille.Name)
    End If
  Next MaFeuille

  ValidationReservation = (Me.ListBoxVh.ListCount > 0)
End Function

Private Sub ComboDateDébut_Change()
  Me.ComboDateFin.Text = Me.ComboDateDébut.Text
End Sub

Private Sub ComboHeureDébut_Change()
  If Me.ComboHeureFin.Value = "" Then
    Me.ComboHeureFin.Text = Me.ComboHeureDébut.Text
  End If
  If TimeValue(Me.ComboHeureFin) < TimeValue(Me.ComboHeureDébut) Then
    MsgBox "L'heure de fin ne peut pas être inférieure à l'heure de début", vbCritical, "ATTENTION ..."
    Me.ComboHeureFin.Text = Me.ComboHeureDébut.Text
  End If
End Sub

Private Sub ComboNomUtilisateur_AfterUpdate()
  Dim NbVal As Integer, Rep
  ' Si le combobox est vide
  If Me.ComboNomUtilisateur.Value = "" Then Exit Sub
  ' Max d'utilisateurs = 55
  NbVal = Application.Evaluate("COUNTA(Params!A:A)")
  If NbVal = 55 Then
    MsgBox "Le nombre d'utilisateurs maximum est déjà atteint !"
    Me.ComboNomUtilisateur.Value = ""
  End If
  ' Si le nom a été saisi et n'existe pas dans la liste
  If Me.ComboNomUtilisateur.ListIndex = -1 Then
    Rep = MsgBox("Cet utilisateur n'existe pas dans la liste, voulez-vous le créer ?", vbQuestion + vbYesNo, "QUESTION ....")
    If Rep = vbYes Then
      ' Seul l'administrateur à le droit => demander le mot de passe
      UsFAdmin.Show
      If ModeAdm = False Then Me.ComboNomUtilisateur.Value = "": Exit Sub
      ' Ajoute l'utilisateur à la liste
      Sheets("Params").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = Me.ComboNomUtilisateur
      ' Ajoute l'utilisateur au combobox
      Me.ComboNomUtilisateur.AddItem Me.ComboNomUtilisateur
    End If
  End If
End Sub

Private Sub ListBoxVh_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Dim TabF As String
  Dim RUser As Range
    ' Remplissage du tableau des feuilles à ne pa sprendre en compte
  TabF = "Jours ouvrés;Menu;Data;Params;Cadre;Impression"
  '
  ' Calcul de la ligne de date de DEBUT
  LigDeb = 3 + DateValue(Me.ComboDateDébut) - DateValue(Sheets("Jours ouvrés").Range("B4")) + 1
  LigFin = 3 + DateValue(Me.ComboDateFin) - DateValue(Sheets("Jours ouvrés").Range("B4")) + 1
  '
  ' Calcul la colonne d'heure DEBUT
  IndCol = Abs(Minute(Me.ComboHeureDébut) = 30) ' Augmente d'une colonne si heure de début contient 1/2 heure
  ColDebH = ((Int(TimeValue(Me.ComboHeureDébut) * 24) - 7 + 1) * 2) + IndCol
  '
  ' Calcul la colonne d'heure FIN
  IndCol = IIf(Minute(Me.ComboHeureFin) = 30, 0, -1) ' Diminue d'une colonne si heure de début contient 1/2 heure
  ColFinH = ((Int(TimeValue(Me.ComboHeureFin) * 24) - 7 + 1) * 2) + IndCol

  If ListBoxVh.Value <> "" Then
    If LigDeb = LigFin Then
      Set MaPlage = Range(Cells(LigDeb, ColDebH), Cells(LigDeb, ColFinH))
    Else
      ' Traitement d'un écart de plusieurs dates
      For Lig = LigDeb To LigFin
        If Lig = LigDeb Then
          Set MaPlage = Range(Cells(LigDeb, ColDebH), Cells(LigDeb, 25))
        End If
        If Lig > LigDeb And Lig < LigFin Then
          Set MaPlage = Union(MaPlage, Range(Cells(Lig, 2), Cells(Lig, 25)))
        End If
        If Lig = LigFin Then
          Set MaPlage = Union(MaPlage, Range(Cells(LigFin, 2), Cells(LigFin, ColFinH)))
        End If
      Next Lig
    End If
    ' Récupérer la couleur du nom
    Set RUser = Sheets("Params").Columns("A:A").Find(What:=ComboNomUtilisateur, After:=Range("A1"), LookIn:=xlFormulas, _
                                                     LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                                     MatchCase:=False, SearchFormat:=False)
    CouleurUser = RUser.Interior.ColorIndex
    Set RUser = Nothing ' Effacer la variable objet

    If InsertionData Then
      If MiseEnFormeReservation(ListBoxVh.Value) Then
        MsgBox "La réservation est enregistrée"
      Else
        MsgBox "Une erreur est survenue durant la mise en forme du calendrier" & vbCr & vbCr & "La réservation est enregistrée mais pas affiché dans le calendrier", vbCritical
      End If
    Else
      MsgBox "Une erreur est survenue durant l'enregistrement" & vbCr & vbCr & "La réservation n'est pas enregistrée", vbCritical
    End If

  End If

End Sub

Private Function InsertionData() As Boolean
  Dim resultat As Boolean
  Dim LigneFin As Integer
  On Error GoTo fin
    With Sheets("Data")
      LigneFin = .Range("A" & Rows.Count).End(xlUp).Row + 1
      'Numéro de transaction
      If LigneFin = 2 Then
        .Cells(LigneFin, 1) = 1
      Else
        .Cells(LigneFin, 1) = .Cells(LigneFin - 1, 1).Value + 1
      End If
      'Nom utilisateur
      .Cells(LigneFin, 2) = Me.ComboNomUtilisateur
      'Objet
      .Cells(LigneFin, 3) = Me.ListBoxVh.Value
      'Date début
      .Cells(LigneFin, 4) = DateValue(Me.ComboDateDébut.Value)
      'Heure debut
      .Cells(LigneFin, 5) = Me.ComboHeureDébut.Value
      'Date fin
      .Cells(LigneFin, 6) = DateValue(Me.ComboDateFin.Value)
      'Heure fin
      .Cells(LigneFin, 7) = Me.ComboHeureFin.Value
      'Plage
      .Cells(LigneFin, 8) = MaPlage.Address
      'Commentaire
      .Cells(LigneFin, 9) = Me.Commentaire.Value
    End With
    resultat = True
fin:
  InsertionData = resultat
End Function

Private Function MiseEnFormeReservation(NomFeuille As String) As Boolean
  Dim resultat As Boolean, FirstCel As String
  'On Error GoTo fin
 ' Déprotéger la feuille
 Call Protection(NomFeuille, False)
  ' Faire la mise en forme
 With Sheets(NomFeuille)
    ' Inscrire le nom dans la première cellule
   [color=#FF0000]FirstCel = Left(MaPlage.Address, InStr(1, MaPlage.Address, ":") - 1)[/color]
    .Range(FirstCel).Value = Me.ComboNomUtilisateur
    With .Range(MaPlage.Address)
    .Merge
    .Interior.ColorIndex = CouleurUser
    '.HorizontalAlignment = xlCenter
   .HorizontalAlignment = xlCenterAcrossSelection
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    'Ajout des commentaires
    If Commentaire <> "" Then Sheets(NomFeuille).Range(FirstCel).AddComment Text:=Commentaire.Text
   End With
  End With
  resultat = True
fin:
  MiseEnFormeReservation = resultat
  ' Protéger la feuille
 Call Protection(NomFeuille, True)
End Function

Private Sub UserForm_Initialize()
  Dim Cell As Range
  With Sheets("Params")
    'affiche la liste des utilisateurs
    For Each Cell In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
      ComboNomUtilisateur.AddItem (Cell)
    Next
  End With
  With Sheets("Params")
    ' Inscrit les valeurs dans les listes déroulantes des dates
    For Each Cell In .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
      ' N'afficher dans la liste que les jours ouvrés : du lundi au samedi
      If Weekday(Cell, vbMonday) < 6 Then
        Me.ComboDateDébut.AddItem (Cell)
        Me.ComboDateFin.AddItem (Cell)
      End If
    Next
  End With
  With Sheets("Params")
    ' Inscrit les valeurs dans les listes déroulantes des heures
    For Each Cell In .Range("C2:C" & .Range("C65536").End(xlUp).Row)
      Me.ComboHeureDébut.AddItem Format((Cell), "hh:mm")
      Me.ComboHeureFin.AddItem Format((Cell), "hh:mm")
    Next
  End With
ComboNomUtilisateur.Value = nom_utilisateur_de_poste
End Sub

Private Sub ClearFiche()
  ComboNomUtilisateur.Text = ""
  ComboDateDébut.Text = ""
  ComboHeureDébut.Text = ""
  ComboHeureFin.Text = ""
  ListBoxVh.Clear
  ListBoxVh.Visible = False
  LbInfo.Visible = False
  LbReservation.Visible = False
End Sub

merci pour votre aide et bonne journée à tous

Le 28/09/2010 à 13:15

Bonjour,

Sur ton cursus, tu en es à 63 messages dans ce forum....

Il m'étonne que tu puisses donner quelques 293 lignes de codes, contenant une erreur sans pour autant :

- spécifier à quelle ligne ce code erreur fait référence

- A la rigueur, joindre un fichier exemple, parce que je n'ai vraiment pas envie, tout comme mes collègues, d'essayer de recréer un fichier, avec USF, qui pourrait reproduire le même code d'erreur....

Donc, si tu veux une aide efficace, aide-nous à t'aider....

Bonne chance

Le 28/09/2010 à 13:33

RE,

Oups, j'ai mis la ligne en rouge mais oublié de le préciser dans message et a priori elle n'apparait pas en rouge!!!!

Donc c'est dans le module MiseEnFormeReservation à la ligne 9

Private Function MiseEnFormeReservation(NomFeuille As String) As Boolean
  Dim resultat As Boolean, FirstCel As String
  'On Error GoTo fin
' Déprotéger la feuille
Call Protection(NomFeuille, False)
  ' Faire la mise en forme
With Sheets(NomFeuille)
    ' Inscrire le nom dans la première cellule
  <span style="color: #FF0000">FirstCel = Left(MaPlage.Address, InStr(1, MaPlage.Address, ":") - 1)</span>
    .Range(FirstCel).Value = Me.ComboNomUtilisateur
    With .Range(MaPlage.Address)
    .Merge
    .Interior.ColorIndex = CouleurUser
    '.HorizontalAlignment = xlCenter
  .HorizontalAlignment = xlCenterAcrossSelection
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    'Ajout des commentaires
   If Commentaire <> "" Then Sheets(NomFeuille).Range(FirstCel).AddComment Text:=Commentaire.Text
   End With
  End With
  resultat = True
fin:
  MiseEnFormeReservation = resultat
  ' Protéger la feuille
Call Protection(NomFeuille, True)
End Function

désolé

Le 28/09/2010 à 13:51

Re-,

Je vais essayer de te répondre, tout comme je tape sur mon clavier, c'est à dire sans regarder, donc sans filet.....

Dans la ligne qui te pose problème, à fortiori le seul terme qui pourrait te causer des soucis, serait "MaPlage"

Or, tu déclares cette variable en haut de module, en "Private"

Tu as une raison pour la déclarer en "Private"?

Sinon, la première cellule d'une "plage", peut être obtenue par cette simple ligne :

FirstCel  = MaPlage(0).Address

Mais je doute que l'erreur soit dans ta façon de trouver la première cellule de ta plage, mais plutôt dans ta déclaration de variable...

Mais tout ceci, en aveugle...

Le 28/09/2010 à 15:35

merci cousinhub pour ta réponse,

mais si je mets le code que tu me donne je perds le nom de la personne qui réserve dans la première cellule.

Le 28/09/2010 à 15:51

Re-,

Ma canne blanche vient de cesser de me soutenir....

Désolé, je ne travaille plus en aveugle....

Bon courage....

PS, un petit fichier exemple ne pourrait-il pas reproduire ton problème?

Sinon, ton fichier, sur cijoint, avec des données bidons....

Edit, et je viens de relire ta dernière réponse :

mais si je mets le code que tu me donne je perds le nom de la personne qui réserve dans la première cellule.

Je pourrais me tromper, mais si tu obtenais une réponse à cette ligne, "AVANT", donc le problème ne se situe pas à ce niveau.....

?????????????????????????????????????????????????????????????????????????????????????

Le 29/09/2010 à 12:29

Re,

je n'ai pas accès à ce site depuis mon micro entreprise,je le ferais de chez moi ce soir.

Bonne journée

Rechercher des sujets similaires à "tranche horaire planning"