Mise en forme conditionnelle sur clic

Bonjour à tous,

je vous expose ma difficulté :

je suis en train de faire un tableau :

Dans les lignes, j'ai une liste d'activités (ex : mécanique, robotique etc.)

En colonnes, j'ai une liste de secteur d'activité (ex : Agroalimentaire, logistique etc.)

Je souhaiterais faire apparaître, dans une liste de fournisseurs qui est dans une colonne indépendante du tableau, un nom en surbrillance lorsque je clique dans une cellule qui est à l'intersection d'une ligne et d'une colonne du tableau.

Ex, si je souhaite trouver un fournisseur qui fait de la robotique dans le secteur de la logistique, je clique à l'intersection de la ligne et de la colonne ad'hoc et le fournisseur "Dupont" passe en surbrillance (couleur par ex).

Est-ce possible de faire ça dans Excel ?

si oui, comment faire ?

En vous remerciant par avance,

Bien à vous,

Thierry

Salut Thierry,

A peine inscrit et déjà de mauvaises habitudes!

Je comprends le truc et d'autres aussi MAIS,

A+

Salut Curulis,

Merci de ton message.

Fallait bien que j'en fasse une pour démarrer.

Je rectifie vite mon erreur, voici donc un fichier exemple.

En cliquant sur une case du tableau vert, je souhaiterais surligner un ou plusieurs noms de société qui correspondent à l'activité croisée de la colonne et de la ligne.

Merci de ton aide.

Salut Thierry et

je sais pas si j'ai bien compris ce qu'il faut faire mais voici une idée, en cliquant une fois ou deux fois sur les céllules vertes

Salut m3ellem1,

C'est effectivement ça que je recherche.

En cliquant sur une cellule du tableau, j'affiche les fournisseurs qui correspondent au cumul des activités en colonne et en ligne.

Exemple :

Je souhaite avoir un fournisseur qui fasse de la mécanique dans le secteur de l'aéronautique.

Je clique donc dans la case C7.

Le fournisseur qui correspond par exemple est "Aeroflot" (çà c'est décidé par moi et inscrit dans le programme VB), La cellule A3 correspondant au nom de ce fournisseur doit donc être surlignée.

C'est le cas dans ton exemple, bravo et

Il faut donc que je puisse maintenant affecter, pour chaque cellule du tableau (C2 à E7), une ou plusieurs cellules correspondant aux fournisseurs (colonne A).

Et a chaque fois que je clique dans le tableau dans un nouvelle cellule, je remet à zéro le surlignage des fournisseurs de la cellule du tableau clickée précédemment, mais pas par un double click comme tu l'as fait dans ton programme mais plutot automatiquement lors d'un autre click.

Exemple :

Je clicque sur C7 je surligne A3 (Aeroflot)

puis je clique sur E6, je surligne A7 (Inrep) et A3 n'est plus surlignée (car le fournisseur Aeroflot ne correspond pas aux activités choisies dans le tableau).

Bien évidemment, pour un click dans une cellule du tableau (qui passerait également en surligné), je peux avoir une ou plusieurs cellules de la colonne A surlignée(s).

Par exemple, si je rentre dans ma colonne un nouveau fournisseur qui s'appelle "Aérotruc" en A8, il se peut qu'en cliquant en C7 (fournisseur faisant de la mécanique en secteur aéronautique", les cellules A3 (Aéroflot) et A8 (Aérotruc) soient surlignées.

Voir exemples 1 et 2 dans le tableau joint.

Merci encore de ton aide.

Salut Thierry,

Salut m3ellem1,

c'est très gentil tout ça mais, à moins d'avoir loupé une étape, sur quelle BDD de fournisseurs peut-on se baser pour lancer quelque chose de concret ?

A+

je ne pensais pas faire un BDD fournisseurs.

J'en ai environ 30 et ils seront tous listés dans la colonne A.

J'en rajouterai surement de temps en temps dans la colonne. Il y en aura peut-être 40 dans un an.

Dois-je faire plutôt une BDD pour ça ?

Salut Thierry,

je ne pige pas comment faire la relation entre les fournisseurs et les spécialités demandées...

CREA C, BDM Tech ?? Comment je fais pour savoir ce qu'ils font ?

A+

Salut Curulis,

Ah oui, je n'ai pas été assez explicite à ce sujet.

En fait, je veux faire un tableau de consultation de fournisseurs en fonction de leur spécialités.

Mais quand je rentre un nouveau fournisseur dans la colonne A, il va falloir que j'intervienne manuellement dans la formule du VBA pour affecter mon fournisseur à une cellule du tableau.

Il n'y a rien d'automatique entre la colonne A et le tableau, la relation est écrite en dur dans le code VBA, c'est moi qui décide de ça pour chaque fournisseur.

Il faudra simplement que j'écrive dans la formule en VBA par exemble :

Si C7 est cliqué, alors je surligne A3 et je ne surligne pas les autres cellules.

Il faudra que je fasse ça manuellement pour chaque cellule du tableau dans le code VBA.

En fait, le travail est à faire une fois pour l'ensemble des fournisseurs de ma liste, et à chaque fois que je rentrerais un nouveau fournisseur.

En fait, il me faudrait une ligne de code idéalement pour chaque cellule du tableau.

A moins que tu proposes quelque chose d'autre qui pourrait être plus simple.

J'espère être clair.

Salut Thierry, slt Curulis

ThierryBdx a écrit :

Dois-je faire plutôt une BDD pour ça ?

à mon avis oui, c'est mieux d'adapter à chaque fois le code.

Voici une idée avec BDD avec actualisation automatique de la liste des fournisseurs dans la colonne A du "Tableau", il reste maintenant juste à adapter le code pour faire une recherche dans la BDD pour surligner les fournisseurs. (je vois ca ce soir)

Salut m3ellem1,

Merci beaucoup, ça commence à prendre tournure.

Effectivement, pas mal avec la BD.

J'attends impatiemment la suite.

Il faut prendre en considération dans la code que le nombre d'activités en colonnes et lignes va être plus important que dans l'exemple mais je pense que tu l'avais compris.

A plus tard

Salut Thierry,

Salut m3ellem1,

un premier jet sur base du travail de m3ellem1 sur "ta" BDD.

La macro calcule la position et les dimensions de ton tableau d'activité à condition que la ligne 1 serve uniquement aux libellés des spécialités (Robotique,...) à l'exclusion de toute autre information.

Tu peux en mettre, évidemment, mais il faudra alors adapter le code!

Afficher ta liste de fournisseurs à partir de [A1] serait par exemple un cas obligeant à une adaptation!

S'il n'y a pas de fournisseur pour la recherche en cours, la case cliquée en rougit de honte!

Pour la simplicité des calculs, laisse, dans 'BDD', 10 lignes pour chaque spécialité. S'il en faut plus, on avisera.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim rCel As Range, iRow%, iTot%, sColA$, sColB$
'
If Not Intersect(Target, Range("C2:E7")) Is Nothing Then
    On Error Resume Next
    '
    sColA = Chr(64 + Range("A1").End(xlToRight).Column)
    sColB = Chr(64 + Cells(1, Columns.Count).End(xlToLeft).Column)
    iRow = Range(sColB & Rows.Count).Offset(0, 1).End(xlUp).Row
    Range(sColA & "2:" & sColB & iRow).Value = ""
    Range(sColA & "2:" & sColB & iRow).Interior.ColorIndex = 35
    Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Interior.Color = xlNone
    Target.Value = "X"
    '
    With Worksheets("BDD")
        iRow = .Columns(1).Find(what:=Cells(1, Target.Column), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
        sColA = Chr(64 + .Rows(1).Find(what:=Cells(Target.Row, 6), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Column)
        For Each rCel In .Range(sColA & iRow).Resize(10, 1)
            If rCel.Value <> "" Then
                iTot = iTot + 1
                Range("A:A").Find(what:=rCel.Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Interior.ColorIndex = 15
            End If
        Next
    End With
    If iTot = 0 Then Target.Interior.ColorIndex = 3
    '
    On Error GoTo 0
End If
'
End Sub

Je continue à développer quelques petits délires... et je reviens plus tard!

A+

Joli travail Curulis

c'est du Teamwork

bon voici ta version combinée avec la mienne

Bonne nuit

Alors là, je dis bravo à vous deux.

Ça marche Nickel.

C'est du lourd pour moi en programmation, j'ai bien du mal à comprendre votre code.

Mais vous n'allez pas vous en tirer comme ça...

Pouvez-vous me dire comment je dois adapter le code si je veux rajouter dans la BDD un nouvelle rubrique en ligne (Automatismes en L32 à L41) et une nouvelle rubrique en colonne (Automobile en H) ?

Et donc un tableau qui passe donc de 15 cellules (3X5) à 24 cellules (4X6).

J'ai bien compris qu'on garde A1 uniquement pour la partie "spécialités"

La liste des fournisseurs commencera bien en A2, ça n'est pas gênant.

Encore

Salut vous deux,

j'y travaille, Thierry : tout automatique... mais, un peu de patience, stp!

• ajouter des activités, des spécialités, les enlever ;
• ajouter ou enlever des fournisseurs ;
• le tout depuis la BDD.

Cela dit, ce code ci-dessous est meilleur.

Tant qu'à calculer la localisation du tableau, autant le faire AVANT de cliquer dedans, non ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim rCel As Range, iRow%, iTot%, sColA$, sColB$
'
sColA = Chr(64 + Range("A1").End(xlToRight).Column)
sColB = Chr(64 + Cells(1, Columns.Count).End(xlToLeft).Column)
iRow = Range(sColB & Rows.Count).Offset(0, 1).End(xlUp).Row
'
If Not Intersect(Target, Range(sColA & "2:" & sColB & iRow)) Is Nothing Then
    On Error Resume Next
    '
    Range(sColA & "2:" & sColB & iRow).Value = ""
    Range(sColA & "2:" & sColB & iRow).Interior.ColorIndex = 35
    Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Interior.Color = xlNone
    Target.Value = "X"
    '
    With Worksheets("BDD")
        iRow = .Columns(1).Find(what:=Cells(1, Target.Column), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
        sColA = Chr(64 + .Rows(1).Find(what:=Cells(Target.Row, 6), lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Column)
        For Each rCel In .Range(sColA & iRow).Resize(10, 1)
            If rCel.Value <> "" Then
                iTot = iTot + 1
                Range("A:A").Find(what:=rCel.Value, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Interior.ColorIndex = 15
            End If
        Next
    End With
    If iTot = 0 Then Target.Interior.ColorIndex = 3
    '
    On Error GoTo 0
End If
'
End Sub

A+

Ah en plus tu anticipes mes demandes

Tout en automatique sur la BDD, ce serait génial.

Quant au tableau, on peut effectivement le dessiner avant (si j'ai bien compris ta question).

De toute façon, je vais le construire une fois avec toutes les activités, les spécialités et les fournisseurs que j'ai déjà en liste.

Je ferai évoluer les activités et les spécialités bien moins souvent que les fournisseurs, donc ça ne me gène pas que le tableau soit construit manuellement et pas forcement en automatique.

Bonsoir Thierry,

toujours en train de chipoter à cette heure ?

A ton aise pour faire ton tableau manuellement !

Fais attention à écrire libellés du tableau et fournisseurs de manière parfaitement identique dans la BDD... sinon, pas de résultats de recherche !

A+

Ouaip, toujours là à cette heure...je me suis calé sur ton rythme de travail...

Mais plus pour longtemps, je vais rejoindre Morphée dans 5 mn.

Ok, je vais faire attention aux libellés, c'est promis.

Juste une question de néophyte : quand je rajoute une colonne, en la sélectionnant tout passe en rouge car j'ai la macro active.

Pour redimensionner le tableau, il faut surement que j'arrête la macro mais je ne sais pas comment faire !

Thierry,

pour pouvoir travailler sur la feuille "hors macro" en toute sérénité, il faut passer en "Mode Création".

• installer le menu "Développeur" si ce n'est pas déjà fait via les options d'Excel ;
• cliquer sur le menu "Développeur" ;
• dans le ruban "Développeur", cliquer sur l'icône "Mode Création" ;
• ... recliquer sur l'icône après, hein ?!

Bonne nuit !

A+

Salut Thierry,

bien dormi ?

Au boulot!

Voici une première ébauche de mes délires... à améliorer et/ou corriger, évidemment!

Code à coller dans le module VBA de 'BDD'.

Tout se passe dans 'BDD'.

• tu peux ajouter, corriger, enlever des fournisseurs. La liste se recrée d'office à chaque changement, triée sans doublons ;
• tu peux corriger simplement les divers libellés du tableau de recherche, sans plus.
• tu ne peux pas créer de nouvelles rubriques ou en enlever! Demain!
• le curseur se place quasi tout seul à la bonne place : pas besoin de vraiment "viser" la bonne cellule.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim rCel As Range, iRow%, iRowT%, sColA$, sColB$
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
With Worksheets("Tableau")
    sColA = Chr(64 + .Range("A1").End(xlToRight).Column)
    sColB = Chr(64 + .Cells(1, Columns.Count).End(xlToLeft).Column)
    iRow = .Range(sColB & Rows.Count).Offset(0, 1).End(xlUp).Row
    '
    With Worksheets("Tableau")
        Select Case CInt(Split([B1000], "/")(0))
            Case 0
                With .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
                    .Value = ""
                    .Borders.LineStyle = xlLineStyleNone
                End With
                sColA = Chr(64 + Cells(1, Columns.Count).End(xlToLeft).Column)
                iRow = Range("A" & Rows.Count).End(xlUp).Row + 9
                iRowT = 2
                For Each rCel In Range("B2:" & sColA & iRow)
                    If rCel <> "" Then
                        iRowT = iRowT + 1
                        .Cells(iRowT, 1) = rCel.Value
                    End If
                Next
                .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1
                With .Range("A3:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlMedium
                    .Sort key1:=.Range("A3"), order1:=xlAscending, Orientation:=xlByRows
                End With
            Case Else
                sLib = Split([B1000], "/")(1)
                If sLib <> "" And Target <> "" Then
                    .Cells.Find(what:=sLib, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext) = Target.Value
                End If
        End Select
    End With
End With
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim iCol%, iRow%
'
If Selection.Count > 1 Then Exit Sub
Application.EnableEvents = False
On Error Resume Next
'
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
iRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(1, iCol + 1).Interior.Color = xlNone
Cells(iRow + 10, 1).Interior.Color = xlNone
'
[B1000] = "0/"
If Target.Row = 1 Then [B1000] = "1/" & Target.Value & "/"
If Target.Column = 1 Then [B1000] = "2/" & Target.Value & "/"
If Target = "" Then
    Select Case Target.Column
        Case Is = 1
            Range("A" & iRow + 10).Select
            Range("A" & iRow + 10).Interior.ColorIndex = 43
        Case Is > iCol
            Cells(1, iCol + 1).Select
            Cells(1, iCol + 1).Interior.ColorIndex = 43
        Case Else
            If Target.Row > iRow + 10 Then
                Cells(1, 1).Select
                Exit Sub
            End If
            iRow = Target.Row Mod 10
            sCol = Split(Columns(Target.Column).Address(ColumnAbsolute:=False), ":")(1)
            iRow = IIf(iRow > 2, Target.Row - (iRow - 2), IIf(iRow < 2, Target.Row - ((iRow + 10) - 2), Target.Row))
            Range(sCol & WorksheetFunction.Max(Range(sCol & Target.Row).End(xlUp).Row + 1, iRow)).Select
    End Select
End If
'
On Error GoTo 0
Application.EnableEvents = True
'
End Sub

Teste, regarde, soupèse et fais-moi un topo pour ce soir!

Je n'aurai de toute façon plus le temps d'y travailler avant ce soir!

A+