Fonction Texte()

[robindr400]

bonjour la communauté !

est il possible d'inclure dans la fonction texte() un paramètre de couleur.

Ex

="amélioration de "&texte(a4;[rouge] # ##0")

je n'y arrive pas grrrhhh

Merci

 

[Modeste geedee]

Re : Fonction Texte()

Bonsour®

🙁
Une formule ne peut renvoyer qu'une valeur ...

 

[job75]

Re : Fonction Texte()

Bonjour robindr400, Modeste geedee,

Une formule ne peut pas modifier le format d'une cellule, mais on peut la compléter par une macro évènementielle

Dans Module1 :

Function Fond(t$, coul$)
Application.Volatile
Fond = t
End Function

Function Polic(t$, coul$)
Application.Volatile
Polic = t
End Function

Dans le code de la feuille :

Private Sub Worksheet_Calculate()
Dim c As Range
Cells.Interior.ColorIndex = xlNone: Cells.Font.ColorIndex = xlAutomatic 'RAZ facultatif
For Each c In Me.UsedRange
  If c.Formula Like "=Fond(*rouge*)" Then c.Interior.ColorIndex = 3
  If c.Formula Like "=Fond(*vert*)" Then c.Interior.ColorIndex = 4
  If c.Formula Like "=Fond(*bleu*)" Then c.Interior.ColorIndex = 33
  If c.Formula Like "=Fond(*jaune*)" Then c.Interior.ColorIndex = 6
  If c.Formula Like "=Polic(*rouge*)" Then c.Font.ColorIndex = 3
  If c.Formula Like "=Polic(*vert*)" Then c.Font.ColorIndex = 4
  If c.Formula Like "=Polic(*bleu*)" Then c.Font.ColorIndex = 33
  If c.Formula Like "=Polic(*jaune*)" Then c.Font.ColorIndex = 6
Next
End Sub

Fichier joint.

A+

 

[job75]

Re : Fonction Texte()

Re,

Avec cette solution plus générale on peut paramétrer la couleur :

Private Sub Worksheet_Calculate()
Dim a, c As Range, test1 As Boolean, test2 As Boolean, coul As Variant
a = Evaluate("{""rouge"",3;""vert"",4;""bleu"",33;""jaune"",6}")
Cells.Interior.ColorIndex = xlNone: Cells.Font.ColorIndex = xlAutomatic 'RAZ facultatif
For Each c In Me.UsedRange
  test1 = c.Formula Like "=Fond(*,*)"
  If Not test1 Then test2 = c.Formula Like "=Polic(*,*)"
  If test1 Or test2 Then
    coul = Evaluate(Replace(Split(c.Formula, ",")(1), ")", ""))
    coul = Application.VLookup(coul, a, 2, 0) 'RECHERCHEV
    If IsNumeric(coul) Then _
      If test1 Then c.Interior.ColorIndex = coul Else c.Font.ColorIndex = coul
  End If
Next
End Sub

Fonctionne aussi avec la couleur écrite en "dur".

Fichier (2).

A+

 

[job75]

Re : Fonction Texte()

Re,

Notez qu'il n'est pas indispensable de rendre les 2 fonctions volatiles par Application.Volatile.

Si l'on modifie dans la macro le tableau a il suffit ensuite de revalider une formule quelconque pour que toute la feuille soit recalculée.

A+

 

[job75]

Re : Fonction Texte()

Re,

Quand on écrit une fonction personnalisée dans une cellule la casse n'est pas toujours respectée.

Dans ce fichier (3) j'ai donc ajouté Option Compare Text 'la casse est ignorée.

Et supprimé les Application.Volatile des fonctions...

A+

 

[job75]

Re : Fonction Texte()

Re,

Concernant la couleur de la police.

Il est inutile de traiter une formule comme ="amélioration de "&Polic(C4;"rouge")

En effet quand il y a une formule dans une cellule on ne peut pas individualiser les caractères du résultat.

A+

 

[job75]

Re : Fonction Texte()

Re,

Cela dit le post #1 concernait un format nombre 🙄

Alors voyez le fichier joint et ces codes :

Function FormatNombre(n, format$)
FormatNombre = IIf(n = "", "", n)
End Function

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Calculate()
Dim c As Range, t$
On Error Resume Next 'si le format n'est pas reconnu
For Each c In Me.UsedRange
  If c.Formula Like "=FormatNombre(*,*)" Then
    c.NumberFormat = "General" 'RAZ
    t = Mid(c.Formula, InStr(c.Formula, ",") + 1)
    t = Evaluate(Replace(t, ")", "")) 'valeur du 2ème argument
    t = Replace(t, ",", ".")
    t = Replace(t, " ", ",") 'séparateur des milliers
    t = Replace(t, "Rouge", "Red") 'traduction
    t = Replace(t, "Bleu", "Blue")
    t = Replace(t, "Vert", "Green")
    c.NumberFormat = t
  End If
Next
End Sub

A+

 

[job75]

Re : Fonction Texte()

Re,

Un truc intéressant.

Si l'on veut dans le 2ème argument insérer d'autres espaces que le séparateur de milliers, il faut utiliser l'espace insécable de code 160.

Par exemple devant le symbole monétaire €.

Le curseur étant dans la cellule au bon endroit, touche Alt enfoncée, taper 0160.

Fichier (2).

A+