Microsoft 365 Recherche complément de code VBA pr un remplissage de cellule automatique

mqlcolmx · 30 Septembre 2021

Bonjour,

Je suis adhérents dans une petite épicerie solidaire et je souhaite mettre en place un planning accessible à tous.

Pour ce planning, j'ai créé une liste déroulante en cellule [C2] avec le nom des adhérents, et je souhaite qu'après avoir sélectionné leurs noms, les adhérents n'est plus qu'à
cliquer dans la case correspondante pour s'inscrire sur un créneau horaire. En résumé :
1 - l'adhérent choisit son nom dans la liste déroulante
2 - clique sur le créneaux qui lui corresponds dans le planning
3 - la case se remplit avec son nom et se met en couleur.

Pour cela j'ai inséré le code suivant :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Pour une plage
    If Not Intersect(Target, Range("C6:AG9")) Is Nothing Then
        Target.Value = [C2]
        Target.Interior.ColorIndex = 44
    End If
    
End Sub

Je voudrais rajouter à ce code les fonctions suivantes :
- Si on clique sur une case déjà remplit par un autre adhérent, il ne ce passe rien
- Si je sélectionne mon nom dans la liste déroulante et que je clique sur une case dans le planning où il y a déjà mon nom, la case redevient vierge (blanche et sans nom).

Savez-vous comment dois-je procéder ?

Je dois rajouter une boucle dans mon code ?

Jeff

sylvanu · 30 Septembre 2021

Bonjour Mqlcolmx,
Il eût été pertinent de fournir un fichier test, ce qui éviterait d'en construire un.
Un essai en PJ avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Pour une plage
    If Target.Count > 1 Then Exit Sub   ' Sort si plsieurs cellules activées, à voir si doit être conservée
    If Not Intersect(Target, Range("C6:AG9")) Is Nothing Then
        If [C2] <> "mqlcolmx" Then
            If Target.Value = "" Then
                Target.Value = [C2]
                Target.Interior.ColorIndex = 44
            End If
        Else
            PWD = InputBox("Entrez le mot de passe:")
            If PWD = "1234" Then
                Target.Value = ""
                Target.Interior.ColorIndex = 0
            End If
        End If
    End If
End Sub

Pour éviter toute erreur j'ai mis un mot de passe sur votre nom (1234) ce qui évitera les effacements intempestifs.

Microsoft 365 Recherche complément de code VBA pr un remplissage de cellule automatique

mqlcolmx

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Discussions similaires