Discussion :

[misig]

Bonjour à tous,

Je travaille sur un fichier Excel dans lequel je change la couleur du fond et j'ajoute un commentaire dans une feuille selon les informations dans une autre feuille
Le fichier fonctionne bien mais il présente certains problèmes : si je modifie les informations dans une feuille, je dois aller ajuster le code VBA de l'autre feuille et je ne trouve pas la solution à celà

Voir fichier joint pour plus d'informations

Présentation de l'Application:

Selon le poste sélectionné dans la feuille Liste, on copie la couleur du fond et on ajoute le commentaire selon les informations dans la feuille Codes
Si on change la couleur dans la feuille Codes, les couleurs changent également dans le feuille Liste selon le contenu

Pblm :

Si on a plusieurs noms et plusieurs semaines, le fichier devient très lent
Si on ajoute des postes dans la feuille Codes, il faut ajuster le code VBA de la feuille Liste

Objectifs :

Comment faire pour ne jamais changer le code VBA

- Toutes les cellules contenant une valeur dans la feuille Liste auront une liste déroulante avec le code Poste
- Si on fait des modifications dans la feuille Codes, par exemple ajouter ou enlever des postes, la feuille Liste sera ajustée en conséquence sans modifier le code VBA de Worksheet_SelectionChange

Merci

[ARTURO83]

Bonjour,
Voici,
Pièce jointe 382396
Cdlt

[patricktoulon]

re
ajoute "Supprimer dans le sheets code sans couleur et sans texte en "B"

vire tout ton code dans le module sheets liste
et met celui ci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Value
    Case "Agent": Enable_personel 2, Target
    Case "Commis": Enable_personel 3, Target
    Case "Comptable": Enable_personel 4, Target
    Case "Directeur": Enable_personel 5, Target
    Case "Technicien": Enable_personel 6, Target
    Case "Supprimer": Target.ClearContents: Target.Interior.Color = xlNone: Target.ClearComments
    End Select
End Sub
Private Function Enable_personel(index, cel)
    With cel
        .ClearComments
        .Interior.Color = Sheets("codes").Cells(index, 1).Interior.Color
        .AddComment: .Comment.Text Text:=Sheets("codes").Cells(index, 2).Text
    End With
End Function

[a_diard]

Ceci permettrai d'ajouter des éléments dans la liste codes
ajouter une ligne à la zone nommée "Poste" pour avoir un blanc dans la liste

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
poste = ActiveCell.Value
'dans la première colonne de la feuille codes
Set PlageDeRecherche = Sheets("codes").Columns(1)
'*******************************
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=poste, LookAt:=xlWhole)
 
If Trouve Is Nothing Then
    'ici, on ne fait rien si le texte n'est pas dans la liste
    Else
    adressetrouvee = Trouve.Address
    adressecomment = Sheets("Codes").Range(adressetrouvee).Offset(0, 1)
    ActiveCell.Interior.Color = Sheets("Codes").Range(adressetrouvee).Interior.Color
   If Len(adressecomment) > 1 Then
   ActiveCell.AddComment adressecomment
   End If
End If
End Sub

en cas de modification dans la feuille code
"changement de couleur sur 1 poste ou suppression d'un poste"

prévoir un code sur
Private Sub Worksheet_Activate() de la feuille liste.