mise en forme d'une cellule en fonction de la selection d'une autre

**leduq** · 19/03/2025, 11h00

Bonjour,

Je suis une quiche en macro (comme ça, c'est dit

)

J'ai un tableau avec des données (entre autre) de B3 à B22 (évolution possible)
dans cette colonne apparait le nom d'un site de production

à coté de ce tableau, (à partir de I) il y a une carte de France (image importée)
dessus j'ai ajouté des flèches vers les villes des sites de production (pour le moment 20 sites)
au bout de ces flèches, j'ai inscrit dans des cellules le nom des sites.

ce que je voudrais, c'est qu'en cliquant dans le tableau sur la cellule B3 (par exemple) que ça me mette en forme la cellule L6 dans laquelle figure le nom du site inscrit en B3

Merci

**BENNASR** · 19/03/2025, 13h04

Bonjour
tu peux faire avec double clic de souris sur une cellule de la plage (B3:B22) :

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Application.EnableEvents = False
    If Not Application.Intersect(Target, Range("B3:B22")) Is Nothing Then
    Range("L3:L22").Interior.ColorIndex = xlColorIndexNone
        Cells(Target.Row, "L").Interior.Color = vbRed
    End If
    Application.EnableEvents = True
End Sub

**leduq** · 19/03/2025, 14h45

Envoyé par BENNASR

Bonjour
tu peux faire avec double clic de souris sur une cellule de la plage (B3:B22) :

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Application.EnableEvents = False
    If Not Application.Intersect(Target, Range("B3:B22")) Is Nothing Then
    Range("L3:L22").Interior.ColorIndex = xlColorIndexNone
        Cells(Target.Row, "L").Interior.Color = vbRed
    End If
    Application.EnableEvents = True
End Sub

Merci,
et dans l'hypothèse ou B3 = L6 B4 = V23 B5 = AC12 ....
(Parce que "pourquoi faire simple ;-) )

A savoir que j'avais essayé avec une macro et une mise en forme conditionnelle

Macro :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target.Calculate
End Sub

et mise forme avec une formule sur $B$3;$L$6
formule : =CELLULE("row")=LIGNE()

Mais ça ne fonctionne pas

**BENNASR** · 19/03/2025, 22h16

Tu peux utiliser la méthode find de la valeur de la cellule sur laquelle tu cliques et si valeur trouvée tu colore la cellule... De préférence tu limites le champs de recherche si c'est possible
Si tu n arrives pas a confectionner ce bout de code je t envoie un exemple le vendredi

**leduq** · 20/03/2025, 12h17

Arf, je pense que j'ai vue trop gros pour moi ...
je pensais pouvoir adapter la macro qui permet de mettre en forme la cellule (ou une ligne) sélectionnée au fait de pouvoir mettre en forme deux (ou plus) cellules en fonction d'une sélectionnée

**Franc** · 20/03/2025, 12h53

Salut, si je comprends bien, une cellule en colonne B peut apparaître plusieurs fois en colonne L ? Si c'est bien ça, cette macro fait le job.

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
20
21
22
23
24
25
26
27
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellCarte As Range
    Dim site As String
    Dim plageCarte As Range
    Dim cell As Range
 
    ' Vérifie si la sélection est dans la plage B3:B22
    If Not Intersect(Target, Me.Range("B3:B22")) Is Nothing Then
        site = Target.Value 
 
        ' Efface les mises en forme précédentes
        Me.Range("L3:L22").Interior.ColorIndex = xlNone
        Me.Range("L3:L22").Font.Bold = False
 
 
        Set plageCarte = Me.Range("L3:L22")
 
        ' Recherche toutes les cellules correspondantes sur la carte        
        For Each cell In plageCarte
            ' Si trouvé alors mise en forme
            If cell.Value = site Then
                cell.Interior.Color = RGB(255, 255, 0) ' Jaune
                cell.Font.Bold = True
            End If
        Next cell
    End If
End Sub

**leduq** · 20/03/2025, 13h59

Salut Franc

Non, Entre B3 et B22 des noms de sites et entre I2 et AD 23 se trouve une image de la carte de la France avec des flèches pointant vers le lieu des sites
et je voudrais donc qu'en cliquant sur B2 ça me mette en forme L6, B3 mise en forme de V23 ....
voici les correspondances ; mais si je peux au moins avoir pour les deux ou trois premiers, je pourrais continuer pour le reste.
B3=L6
B4=V23
B5=AC12
B6=M18
B7=L15
B8=I10
B9=T2
B10=L12
B11=Q2
B12=AD10
B13=I7
B14=AB19
B15=Y5
B16=Z22
B17=AA13
B18=W3
B19=AB8
B20=M22
B21=o5
B22=AB16

Merci

**leduq** · 20/03/2025, 14h05

C'est bon, j'ai réussi, MERCI à vous deux et surtout à Franc

j'ai adapté ton code :

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
20
21
22
23
24
25
26
27
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellCarte As Range
    Dim site As String
    Dim plageCarte As Range
    Dim cell As Range
 
    ' Vérifie si la sélection est dans la plage B3:B22
    If Not Intersect(Target, Me.Range("B3:B22")) Is Nothing Then
        site = Target.Value
 
        ' Efface les mises en forme précédentes
        Me.Range("I2:AD23").Interior.ColorIndex = xlNone
        Me.Range("I2:AD23").Font.Bold = False
 
 
        Set plageCarte = Me.Range("I2:AD23")
 
        ' Recherche toutes les cellules correspondantes sur la carte
        For Each cell In plageCarte
            ' Si trouvé alors mise en forme
            If cell.Value = site Then
                cell.Interior.Color = RGB(255, 255, 0) ' Jaune
                cell.Font.Bold = True
            End If
        Next cell
    End If
End Sub

et ça fonctionne

MERCI

**Franc** · 20/03/2025, 14h11

Comme ceci alors:

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
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cellCarte As Range
    Dim site As String
    Dim correspondance As Object
    Dim adresseCellule As String
 
    ' Vérifie si la sélection est dans la plage B3:B22
    If Not Intersect(Target, Me.Range("B3:B22")) Is Nothing Then
        ' Création du dictionnaire de correspondance
        Set correspondance = CreateObject("Scripting.Dictionary")
 
        ' Efface les mises en forme précédentes
        Me.Cells.Interior.ColorIndex = xlNone
        Me.Cells.Font.Bold = False
 
 
        ' Remplissage du dictionnaire avec les paires B -> Cellule correspondante
        correspondance.Add "B3", "L6"
        correspondance.Add "B4", "V23"
        correspondance.Add "B5", "AC12"
        correspondance.Add "B6", "M18"
        correspondance.Add "B7", "L15"
        correspondance.Add "B8", "I10"
        correspondance.Add "B9", "T2"
        correspondance.Add "B10", "L12"
        correspondance.Add "B11", "Q2"
        correspondance.Add "B12", "AD10"
        correspondance.Add "B13", "I7"
        correspondance.Add "B14", "AB19"
        correspondance.Add "B15", "Y5"
        correspondance.Add "B16", "Z22"
        correspondance.Add "B17", "AA13"
        correspondance.Add "B18", "W3"
        correspondance.Add "B19", "AB8"
        correspondance.Add "B20", "M22"
        correspondance.Add "B21", "O5"
        correspondance.Add "B22", "AB16"
 
        ' Récupère la cellule cible dans le dictionnaire
        If correspondance.exists(Target.Address(False, False)) Then
            adresseCellule = correspondance(Target.Address(False, False))
 
            ' Applique la mise en forme à la cellule correspondante
            Set cellCarte = Me.Range(adresseCellule)
            cellCarte.Interior.Color = RGB(255, 255, 0) ' Jaune
            cellCarte.Font.Bold = True
        End If
 
        ' Nettoyage du dictionnaire
        Set correspondance = Nothing
    End If
End Sub