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
- Messages
- 4'084
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
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.