XL 2010 Mise en forme de quelques caractères sur formule

[max.lander]

Bonjour à tous,


Je souhaite appliquer une mise en forme sur les derniers caractères d'une cellule.
Cela peut paraître simple mais le hic c'est que la cellule contient une formule.


Je pense que l'exemple en PJ parle de lui même.


Si vous avez des idées je suis preneur.

Merci,

 

[Compte Supprimé 979]

Bonjour max.lander

A ma connaissance, ce n'est pas possible, car c'est une formule !
Seule solution créer une ligne supplémentaire pour inscrire le nombre d'heure entre parenthèse)

 

[Chris401]

Bonjour

Un essai avec ce code à placer dans la feuille OP
Au changement de la valeur de la cellule A11, la formule est mise en place en B11:H11
Elle est ensuite copiée en valeur ce qui permet de mettre les caractères entre parenthèses en couleur

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$11" Then
For Each c In Range("B11:H11")
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Type,MATCH(1,(Ref=RC1)*(Montage=R10C),0)),"""")"
        c.Value = c.Value
        x = InStr(c, "(")
        y = InStr(c, ")")
            c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If
End Sub

 

[max.lander]

BrunoM45, Chris401 merci pour votre aide.

Chris401 le code proposé fonctionne très bien, est il possible d'ajouter un renvoi à la ligne pour le nombre d'heures en parenthèse ?

Merci encore

 

[Chris401]

Re

Essaye :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$11" Then
For Each c In Range("B11:H11")
On Error Resume Next
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Type,MATCH(1,(Ref=RC1)*(Montage=R10C),0)),"""")"
        c.Value = c.Value
        x = InStr(c, "(")
        y = InStr(c, ")")
        c.Value = Left(c, x - 2) & Chr(10) & Right(c, Len(c) - x + 1) 
        c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If
End Sub

 

[max.lander]

Chris401 merci infiniment ça marche du tonnerre !

Si ce n'est pas trop abusé, il est possible d'adapter le même code pour 10 lignes ?



Sinon j'essayerai de bidouiller pour arriver au résultat

PS: j'ai essayé avec une boucle sans succès 🙁

 

[max.lander]

Ma boucle ci-dessous mais c'est pas très propre !

Private Sub Worksheet_Change(ByVal Target As Range)

For i = 11 To 21


If Target.Address = "$A$" & i Then
For Each c In Range("B" & i & ":" & "H" & i)
On Error Resume Next
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Type,MATCH(1,(Ref=RC1)*(Montage=R10C),0)),"""")"
        c.Value = c.Value
        x = InStr(c, "(")
        y = InStr(c, ")")
        c.Value = Left(c, x - 2) & Chr(10) & Right(c, Len(c) - x + 1)
        c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If
   
   
    Next i

Si il y a mieux je prends !

 

[Chris401]

Bonjour

Si tes Ref en colonne A sont déjà en place, il vaudrait mieux peut-être que la macro se déclenche au changement de date en B10

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$10" Then
For Each c In Range("B11:H20")
On Error Resume Next
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Type,MATCH(1,(Ref=RC1)*(Montage=R10C),0)),"""")"
        c.Value = c.Value
        x = InStr(c, "(")
        y = InStr(c, ")")
        c.Value = Left(c, x - 2) & Chr(10) & Right(c, Len(c) - x + 1)
        c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If
End Sub

Autrement, en restant sur la modification de la Ref

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("A11:A20")) Is Nothing And Target.Count = 1 Then
lg = Target.Row
For Each c In Range("B" & lg & ":H" & lg)
On Error Resume Next
        c.Font.ColorIndex = 1
        c.FormulaArray = _
         "=IFERROR(INDEX(Type,MATCH(1,(Ref=RC1)*(Montage=R10C),0)),"""")"
        c.Value = c.Value
        x = InStr(c, "(")
        y = InStr(c, ")")
        c.Value = Left(c, x - 2) & Chr(10) & Right(c, Len(c) - x + 1)
        c.Characters(x, y).Font.ColorIndex = 3
    Next c
    End If
End Sub

 

[max.lander]

Merci Chris ça fonctionne plus que bien :

 

[max.lander]

Bonjour,

Je me permets de revenir pour encore un petit d'aide, car je rencontre un petit bug :
Je me rends compte que j'ai des ratés.


En effet 1 fois sur 5, la ligne

 c.Value = c.Value

capture un zéro au lieu du bon résultat...
Pourtant le formule retourne le bon résultat (quand cette ligne est désactivée)


Vous avez une idée ?

 

[Chris401]

Bonsoir

Tu peux joindre un fichier sur lequel tu rencontres ce problème ?

 

[max.lander]

Voila le fichier joint.

Le problème est rencontré quand j'active plusieurs fois le spinbutton.

Merci

 

[max.lander]

Personne n'a d'idée ?


Merci par avance

Bonne journée.

 

[Chris401]

Bonjour

Désolé pour le temps de réponse, je n'ai pas pu me connecter avant.
L'idéal serait de récupérer les heures en même temps que les noms dans ton code Load_Opérateurs
mais je ne sais pas le faire

Peux-tu essayer ce fichier ? Je le teste en avant et en arrière et cela semble "tenir"

 

[max.lander]

Salut Chris,

ça fonctionne tu peux expliquer ta modif ?

Merci par avance