Rapport de message :*
 

Re: Aide sur planning auto

Titre du sujet : Re: Aide sur planning auto
par JCGL le 18/02/2009 18:08:36

Bonjour à tous,

Peux-tu essayer avec :

Private Sub OK_Click()
If Me.Nom = "" Or Me.Voiture = "" Or Me.Lieu = "" Then Exit Sub 'si les 2 combo "Nom" et "Voiture" sont vides, on sort de la procédure,
                                                'tout en laissant l'usf visible
If Application.Weekday(Me.DTPicker1, 2) > 5 Or _
    Application.Weekday(Me.DTPicker2, 2) > 5 Then Exit Sub  'si on a choisi une date de week-end, idem
If Me.DTPicker1 < [A6] + 6 And Me.DTPicker1 >= [A6] And Me.DTPicker2 <= [A6] + 6 Then 'si la date est bien dans l'onglet
    If Me.DTPicker1 > Me.DTPicker2 Then Exit Sub 'si le retour est antérieur au départ, on sort
    If Me.DTPicker1 = Me.DTPicker2 Then 'si les deux dates sont identiques
        If Val(Left(Me.Arrivée, Len(Me.Arrivée) - 3)) < Val(Left(Me.Départ, Len(Me.Départ) - 3)) Then Exit Sub
            'si l'heure de retour est antérieure à l'heure de départ, on sort
            'Left(Me.Arrivée, Len(Me.Arrivée) - 3) te donne le ou les chiffres anvant le h
            'Val le convertit en nombre
    End If
    Lig = Application.Match(Me.Voiture, Range("A1:A32"), 0) 'on recherche le numéro de ligne de la voiture sélectionnée
            'correspond à la fonction "EQUIV" d'une feuille
    Col = (Int(Me.DTPicker1 - [A6]) * 12) + 2 'comme tes journées tiennent sur 12 colonnes
        'on retrance la date en A6 à la date du DTP1, qu'on multiplie par 12
        'et on rajoute 2 car tes journées commencent en colonne C
    DerCol = (Int(Me.DTPicker2 - [A6]) * 12) + 2 'idem, pour le DTP2
    Prem_Heure = Me.Départ.ListIndex + Col 'on détermine la colonne de départ
                    'Me.Départ.ListIndex donne l'index sélectionné, auquel on rajoute Col
    Der_Heure = Me.Arrivée.ListIndex - 1 + DerCol 'idem, ici le -1, car si retour à09h00, ce créneau est toujours valable
    If Cells(Lig, Prem_Heure).MergeCells Or Cells(Lig, Der_Heure).MergeCells Then 'si les cellules trouvées sont fusionnées
        MsgBox "Créneau déjà utilisé" 'on prévient que le créneau est déjà pris
        Exit Sub 'on sort
    End If
    With Range(Cells(Lig, Prem_Heure), Cells(Lig, Der_Heure))
        .Merge 'fusion des cellules
        .Value = " Pour " & Me.Nom & " à " & Me.Lieu
       ' .Value = Me.Lieu 'on marque le nom et le lieu
        .Interior.ColorIndex = 33 'couleur Bleu
        .HorizontalAlignment = xlCenter 'on centre horizontalement
        .VerticalAlignment = xlCenter 'et verticalement
        .Font.Bold = True 'on met en gras
    End With
Else
    MsgBox "La date entrée ne correspond pas à cette semaine" 'si la date n'est pas dans l'onglet
    Exit Sub
End If
    Unload Me 'on décharge et on ferme l'usf
End Sub

A+ à tous