XL 2016 Création fonction personnalisée Couleur

[Lolote83]

Bonjour à toutes et à tous,

J'ai un tableau Tab_Test avec des matières. En fonction de la matière inscrite colonne E, je souhaiterai que la colonne G (Coul2) se colorie automatiquement.
Je sais faire les MFC mais pour l'exercice, je ne souhaite pas les utiliser.
De fait, j'ai créé une fonction qui récupère la couleur d'un tableau annexe (Ici Tab_Matière).
Donc, si je clique sur le bouton MAJ COUL (pour l'exemple), l'ensemble de mes couleurs sont bien affichées dans la cellule souhaitée.
Ca, c'est OK.

Mais ce n'est pas vraiment ce que je souhaitais au départ.
Au final, je souhaitais me servir directement sur la feuille XL de la fonction (exemple colonne G) avec la formule =Couleur(Cellule), mais cela me donne la valeur de la couleur (c'est normal) alors que j'aurais aimé que cela me colorie le fond de la cellule.
Est-ce possible ?

Merci pour vos réponses
Cordialement
@+ Lolote83

 

[Hasco]

bonjour,

Un principe général c'est qu'une fonction retourne une valeur.
Dans vba excel une fonction ne peut pas modifier la cellule qui l'a appelée.

Cordialement

 

[Lolote83]

Bonjour Hasco.
Je m'en doutais un peut tout de même.

Dans vba excel une fonction ne peut pas modifier la cellule qui l'a appelée.

C'est d'ailleurs bien la valeur que me retourne la fonction, mais je pensais que peut être ?????
Mais ici, ce n'est pas le contenu que je souhaitais modifier, mais le fond. Bref .....


Du coup, je vais rester sur mon bouton MAJ ou affecter la macro au Worksheet_Change ou me servir d'une MFC.
Mais c'était pour l'exercice. Tant pis, j'aurais tenté ma chance.
Merci tout de même.

@+ Lolote83

 

[Hasco]

Bon,

Pour vous consoler, voici une autre manière de chercher dans un tableau de correspondances.
Plutôt que de parcourir à chaque fois le tableau dans une boucle for, la fonction suivante emploi la fonction de feuille de calcul EQUIV pour retrouver l'indice ordinal de la matière dans la première colonne et en renvoyer la couleur de fond.

Function Couleur(xMatiere)
    Dim idx As Variant
    '
    ' Tableau de correspondances Matières/Couleur
    With Range("Tab_Matiere[Matieres]")
        ' Chercher la matière avec l'équivalent de la fonction de feuille EQUIV
        ' dans la première colonne
        idx = Application.Match(xMatiere, .Columns(1), 0)
        ' Si trouvé alors renvoyer la couleur de fond de la deuxième colonne
        If Not IsError(idx) Then Couleur = .Cells(idx, 2).Interior.Color
    End With
End Function

cordialement

 

[Lolote83]

Re bonjour Hasco.
Bien vu ....
C'est vrai que j'utilise très souvent la fonction EQUIV dans mes tableaux, mais j'y pense moins en VBA.
Bonne continuation à vous et à bientôt sur le forum
Cordialement
@+ Lolote83

 

[Lolote83]

Re bonsoir Hasco,
J'ai utilisé votre fonction mais j'y ai rajouté une variable Temp qui permet de ne pas repasser dans la fonction si la cellule testée est identique à la précédente. Je pense que l'on gagne du temps (surtout si les matières sont triées au préalable)

Public xTemp
Public xCoul

Sub MAJ_Coul()
    Application.ScreenUpdating = False
    For Each xCell In Range("Tab_Test[Matière]")                'On parcours l'ensemble des matières du tableau Tab_Test
        If xCell = xTemp Then
            xCell.Offset(0, 1).Interior.Color = xCoul
        Else
            xCell.Offset(0, 1).Interior.Color = Couleur2(xCell)      'On affecte la couleur correspondante à la matière (prise dans le tableau Tab_Matière)
        End If
    Next xCell                                                  'Fin Boucle
    Application.ScreenUpdating = True
End Sub

puis la fonction

Function Couleur(xMatiere)
    Dim idx As Variant
    xTemp = xMatiere
    ' Tableau de correspondances Matières/Couleur
    With Range("Tab_Matiere[Matieres]")
        ' Chercher la matière avec l'équivalent de la fonction de feuille EQUIV dans la première colonne
        idx = Application.Match(xMatiere, .Columns(1), 0)
        ' Si trouvé alors renvoyer la couleur de fond de la deuxième colonne
        If Not IsError(idx) Then
            xCoul = .Cells(idx, 2).Interior.Color
        End If
        Couleur = xCoul
    End With
End Function

@+ Lolote83

 

[Hasco]

bonjour,

Je craint que le temps gagné soit infime. Quel temps est dépensé par l'ajout du test ?
Il faudrait pouvoir comparer sur votre machine avec beaucoup plus de "matières" (au moins 3000).
Votre établissement en dispense-t-il autant ?

Petit détail : votre fonction, je l'appellerais 'CouleurMatiere' plus parlant que 'Couleur'.
Si vous partez le prochain utilisateur de votre macro saura plus facilement de quoi il s'agit.

Cordialement

 

[Lolote83]

Re bonjour Hasco.

Effectivement le temps gagné n'est pas conséquent sur ce modèle d'exemple.
Mais bon, c'était pour faire un test.
Merci pour l'aide apportée en tous cas.
Je vous souhaite un bon week-end. Pour moi ce sera plage ......

Cordialement
@+ Lolote83