Planning automatique avec validation de données

Bonjour à tous.

Il y a quelque mois, un internaute du forum m'a conçu le code VBA ci-dessous.

Il crée automatiquement dans un tableau, des listes déroulantes de choix contenant les noms des personnes ayant données leur disponibilité pour telle ou telle date.

J'aimerai pouvoir modifier ce code pour l'adapter à un nouveau fichier excel, mais je m'y perds dans toutes ces lignes.

Quelqu’un pourrait-il compléter ces lignes en y apportant de petites explications?

Cela me permettrait de modifier à loisir le code pour l'adapter un un nouveau tableau.

Merci pour votre aide.

voici le code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'on construit la liste de validation en fonction de la cellule séletionnée

If Intersect(Target, Range("D5:i760")) Is Nothing Then Exit Sub

ch = Target.Column - 4 'tranche horaire de la cellule

If Target.Row Mod 2 = 0 Then dt = Cells(Target.Row - 1, 3) Else dt = Cells(Target.Row, 3) 'date de la cellule

With Sheets("DISPOS ENSISHEIM CV")

dl = .Cells(Rows.Count, 3).End(xlUp).Row

dc = .Cells(3, Columns.Count).End(xlToLeft).Column

Set pl = .Cells(5, 3).Resize(dl - 5, 1)

Set re = Nothing

For Each d In pl

If d = dt Then Set re = d: Exit For

Next d

If re Is Nothing Then

MsgBox "Date " & dt & " non trouvée dans le planning"

Else

liste = ""

For j = 4 To dc Step 6

n = .Cells(re.Row, j + ch)

If n <> "" Then

liste = liste & n & ","

End If

Next j

With Target.Validation

.Delete

If Len(liste) > 0 Then

liste = Left(liste, Len(liste) - 1)

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _

xlBetween, Formula1:=liste

.IgnoreBlank = True

.InCellDropdown = True

.InputTitle = ""

.ErrorTitle = ""

.InputMessage = ""

.ErrorMessage = ""

.ShowInput = True

.ShowError = True

Else

MsgBox "Personne n'est disponible à cette date"

End If

End With

End If

End With

End Sub

Bonjour,

Déja,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'on construit la liste de validation en fonction de la cellule séletionnée
If Intersect(Target, Range("D5:i760")) Is Nothing Then Exit Sub
ch = Target.Column - 4 'tranche horaire de la cellule
If Target.Row Mod 2 = 0 Then dt = Cells(Target.Row - 1, 3) Else dt = Cells(Target.Row, 3) 'date de la cellule
With Sheets("DISPOS ENSISHEIM CV")
dl = .Cells(Rows.Count, 3).End(xlUp).Row
dc = .Cells(3, Columns.Count).End(xlToLeft).Column
Set pl = .Cells(5, 3).Resize(dl - 5, 1)
Set re = Nothing
For Each d In pl
If d = dt Then Set re = d: Exit For
Next d
If re Is Nothing Then
MsgBox "Date " & dt & " non trouvée dans le planning"
Else
liste = ""
For j = 4 To dc Step 6
n = .Cells(re.Row, j + ch)
If n <> "" Then
liste = liste & n & ","
End If
Next j
With Target.Validation
.Delete
If Len(liste) > 0 Then
liste = Left(liste, Len(liste) - 1)
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=liste
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
Else
MsgBox "Personne n'est disponible à cette date"
End If
End With
End If
End With
End Sub

Il existe un bouton "</>" pour inscrire du code et le mettre en forme. Cela permet une meilleur lisibilité.

Ensuite comment te dire que comprendre un code sans avoir le fichier c'est assez compliqué personnellement je trouve. On ne peut s'appuyer sur rien.... à moins d'être un "monstre" en Excel VBA.

Bien cordialement,

AP

Bonjour,

à moins d'être un "monstre" en Excel VBA.

ou d'avoir écrit le code...

voici le code commenté,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'on construit la liste de validation en fonction de la cellule séletionnée
    If Intersect(Target, Range("D5:I760")) Is Nothing Then Exit Sub    'la case sélectionnée se trouve-t-elle dans la plage D5:I760
    ch = Target.Column - 4    'tranche horaire de la cellule
    If Target.Row Mod 2 = 0 Then dt = Cells(Target.Row - 1, 3) Else dt = Cells(Target.Row, 3)    'date de la cellule sélectionnée
    With Sheets("DISPOS ENSISHEIM CV")    'recherche de la date dans dispos ensisheim cv
        dl = .Cells(Rows.Count, 3).End(xlUp).Row    'dernière ligne
        dc = .Cells(3, Columns.Count).End(xlToLeft).Column    'dernière column
        Set pl = .Cells(5, 3).Resize(dl - 5, 1)    'plage de recherche en colonne C à partir de la ligne 5
        Set re = Nothing    're pointe vers la cellule contenant la date sélectionnée, trouvée dans dispos ensisheim cv
        For Each d In pl    'boucle de recherche de la date
            If d = dt Then Set re = d: Exit For    'date trouvée on arrête la recherche
        Next d
        If re Is Nothing Then    'date non trouvée
            MsgBox "Date " & dt & " non trouvée dans le planning"
        Else
            ' on contruit la liste
            liste = ""
            For j = 4 To dc Step 6    'on parcourt dispos ensisheim cv à partir de la colonne 4 par pas de 6
                n = .Cells(re.Row, j + ch)    'on prend le nom trouvé pour cette tranche horaire
                If n <> "" Then
                    liste = liste & n & ","    'si nom trouvé on l'ajoute à la liste des personnes disponibles
                End If
            Next j
            'on associe la liste de validation à la cellule sélectionnée
            With Target.Validation
                .Delete    'suppression de la liste existante
                If Len(liste) > 0 Then    'si la nouvelle liste contient des noms
                    liste = Left(liste, Len(liste) - 1)    'suppresion de la virgule finale
                    'ajout de la liste de validation à la cellule sélectionnée
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                         xlBetween, Formula1:=liste
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = ""
                    .InputMessage = ""
                    .ErrorMessage = ""
                    .ShowInput = True
                    .ShowError = True
                Else
                    MsgBox "Personne n'est disponible à cette date"
                End If
            End With
        End If
    End With
End Sub

Bonjour,

code commenté et correctement indenté par h2so4.

La lisibilité du code est un élément fondamental pour la maintenance même pour celui qui l'a écrit.

Merci h2so4 d'avoir commenter ton propre code.

Ça m'aide beaucoup pour la suite.

Il y a une ou deux lignes que je ne comprend pas encore l'utilité que je mettrai dans la discutions pour plus d'informations.

Merci beaucoup déjà.

Lionsleep

Voici les lignes sur lesquelles je butte. à quoi servent-elles?

   ch = Target.Column - 4    'tranche horaire de la cellule

   'tranche horaire de la cellule... ça veut dire quoi (tranche) et par rapport à quoi?

    If Target.Row Mod 2 = 0 Then dt = Cells(Target.Row - 1, 3) Else dt = Cells(Target.Row, 3)    'date de la cellule sélectionnée

    'Mod 2 = 0 fait référence à quoi?
    'si =0 il se passe quoi?
    'sinon quoi?   

Merci pour vos explications

LionSleep

LionSleep a écrit :

Voici les lignes sur lesquelles je butte. à quoi servent-elles?

   ch = Target.Column - 4    'tranche horaire de la cellule

   'tranche horaire de la cellule... ça veut dire quoi (tranche) et par rapport à quoi?

    If Target.Row Mod 2 = 0 Then dt = Cells(Target.Row - 1, 3) Else dt = Cells(Target.Row, 3)    'date de la cellule sélectionnée

    'Mod 2 = 0 fait référence à quoi?
    'si =0 il se passe quoi?
    'sinon quoi?   

Merci pour vos explications

LionSleep

difficile de répondre sans avoir le fichier. Ces instructions font référence à la structure des données.

ch= Target.Column - 4

la colonne de la cellule sélectionnée permet de déterminer la tranche horaire par un calcul simple. (n° de colonne de la cellule sélectionnée -4)

  If Target.Row Mod 2 = 0

permet de tester si le n° de ligne de la cellule sélectionnée est pair ou non et donc de déterminer dans quelle cellule se trouve la date qui nous intéresse pour la cellule sélectionnée.

si le résultat est 0, le numéro de ligne est pair et la date se trouve dans la ligne du dessus en colonne 3, si le résultat n'est pas 0, la date se trouve dans la même ligne en colonne 3, par rapport à la cellule sélectionnée.

D'accord! Je n'aurai jamais pensé à cela.

Dès que je peux, je mettrai le fichier en ligne.

Merci beaucoup. Tout devient petit à petit plus clair.

Domage que la langage vba se rédige en anglais.

Voici le fichier

La macro qu'a conçu h2so4 se déclenche sur la feuille "TPL CV.

Les onglets qui nous intéressent sont:

DISPOS LIEU 1

TPL CV

Les données renseignées sur la feuille DISPOS LIEU 1 (qui regroupe les disponibilités des membre de l'association), se retrouveront automatiquement sur la feuille TPL CV sous forme de liste déroulantes de choix.

Chaque liste contiendra uniquement les membre dispos pour telle ou telle date. Magique!!!

Merci heso4 pour ton travail.

Mon objectif; comprendre cette macro pour pouvoir l'adapter à un nouveau fichier.... si toutefois j'en serai capable un jour.

Plus d'info sur le fichier:

l'onglet "MES DISPOS LIEU ":

J'envoie un fichier contenant cet onglet à chaque membre. Il le complète...je copie/colle ces données dans le fichier sur l'onglet "DISPOS LIEU 1" pour chaque membre dans les colonnes leur étant réservées.

Dans les listes déroulantes de choix, sur l'onglet "TPL CV" figureront leur noms s'ils sont dispos.

Le prochain planning sur lequel je travail en se moment me semble moins compliquer à concevoir car il ne traite que les week-end et il n'y aura qu'un poste à combler par week-end.

Je peux joindre le fichier également si vous voulez jeter plus qu'un œil!

A bientôt

LionSleep

J'ai repris le code VBA de h2so4, pour l'utiliser dans un nouveau classeur excel, mais je n'arrive pas à le faire fonctionner.

Ce nouveaux planning n'a pas le même nombre de lignes et de colonnes. C'est très certainement pour cela que ça ne fonctionne

pas.

Je ne comprend pas pourquoi, dans les validations de données, des valeurs s’enlèvent au fur et à mesure que je passe de colonne en colonne...

Je joint le fichier, si quelqu’un pourrait m'aider à l’adapter pour ce nouveau classeur.

Je vous en remercie.