formatage d'un chiffre d'une phrase

Version imprimable

Bonjour le forum
Je viens de découvrir ce code permettant de mettre en couleur et en taille un chiffre se trouvant dans une phrase sise dans une cellule.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Private Sub Worksheet_Change(ByVal Target As Range) Dim c1 As Range, c2 As Range, c3 As Range Set c1 = [A1]: Set c2 = [A2]: Set c3 = [A3] If Intersect(Target, Union(c1, c2)) Is Nothing Then Exit Sub c3 = c2 If c1 = "" Then Exit Sub With c3.Characters(InStr(c3, c1), Len(c1)).Font .ColorIndex = 3 'rouge .Bold = True 'gras .Size = 20 End With End Sub
ce code fonctionne lorsque l'on change manuellement la valeur de la A1
Ce que je souhaiterais est que le code fonctionne quand la valeur A1 change suite à un calcul.
D'après 78Chris il semblerait qu'il n'est pas possible depuis le résultat d'une formule. C'est mon cas d'où mon interrogation.
Est ce que cela est possible ?
Cordialement

Bonjour,

Citation:

Envoyé par lmc71

Ce que je souhaiterais est que le code fonctionne quand la valeur A1 change suite à un calcul.

Tu peux essayer avec cette macro sur calcul :
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub Worksheet_Calculate() Dim c1 As Range, c2 As Range, c3 As Range Set c1 = [A1]: Set c2 = [A2]: Set c3 = [A3] c3 = c2 If c1 = "" Then Exit Sub With c3.Characters(InStr(c3, c1), Len(c1)).Font .ColorIndex = 3 'rouge .Bold = True 'gras .Size = 20 End With End Sub

03/12/2019, 00h22
lmc71

1 pièce(s) jointe(s)

Re Anasecu
Merci de ta réponse rapide.
J'ai essayé sur un nouveau fichier et l'effet escompté n'a pas apparu.
Peut-être que je m'y suis mal pris.
Je te joins ce bout de fichier avec explications.
Cordialement
03/12/2019, 06h07
Transitoire

Bonjour,

Citation:

Ce que je souhaiterais est que le code fonctionne quand la valeur A1 change suite à un calcul.

D'ou ma question, quel est l'évenement qui déclenche le calcul qui va modifier la valeur de A1? Car je pense que c'est aussi par la que l'on peut avoir un accès à la modification ou au calcul.
Cordialement 8-)

Bonjour lmc71,

Citation:

Envoyé par lmc71

J'ai essayé sur un nouveau fichier et l'effet escompté n'a pas apparu.Peut-être que je m'y suis mal pris.

Tu as mal positionné ta fin de procédure, regardes comme ceci et cela va fonctionner
Code:

1 2 3 4 5 6 7 8 9 10 11 Private Sub Worksheet_Calculate() Dim c1 As Range, c2 As Range, c3 As Range Set c1 = [F1]: Set c2 = [A2]: Set c3 = [B4] c3 = c2 If c1 = "" Then Exit Sub With c3.Characters(InStr(c3, c1), Len(c1)).Font .ColorIndex = 3 'rouge .Bold = True 'gras .Size = 20 End With End Sub

03/12/2019, 09h35
lmc71

1 pièce(s) jointe(s)

Bonjour Anasecu
merci
Excuses moi pour cette erreur grossière que je n'arrivais pas à voir.
Tout fonctionne et je l'ai transporté sur mon fichier définitif et euréka ça fonctionne.
Je voudrais te demander si dans la phrase où il existe deux chiffres, est-ce qu'il est possible de les mettre les deux en forme.
Ces deux chiffres proviennent de deux formules différentes et se trouvent dans deux cellules différentes.
Voici les genre de phrase : Liste des 24 pays dans 6 groupes. Ce sont 24 et 6 à mettre en forme. Pour 24 c'est résolu.
J'ai essayé de modifier ton code mais sans résultat probant. Seul le deuxième chiffre a été mis en forme.
Cordialement
03/12/2019, 11h54
anasecu

re

Citation:

Envoyé par lmc71

J'ai essayé de modifier ton code mais sans résultat probant. Seul le deuxième chiffre a été mis en forme.

Normal car tu as mis 2 fois [B14]

Code:

Set c1 = [F1]: Set c2 = [A2]: Set c3 = [B14]

Il te faut corriger et remettre ton [B4]

Code:

Set c1 = [F1]: Set c2 = [A2]: Set c3 = [B4]
03/12/2019, 18h36
lmc71

Re
J'ai mis B14 car je ne veux qu'une seule phrase et non pas deux, car B4 est le 24 qui est formaté et B14 c'est le 6 qui l'est.
Je dois probablement en déduire qu'il est impossible (à mon niveau) d'avoir une seule phrase avec deux formatages ou plus, sinon par bidouillage.
Cordialement

Bonsoir lmc71,

Citation:

Envoyé par lmc71

Je dois probablement en déduire qu'il est impossible (à mon niveau) d'avoir une seule phrase avec deux formatages ou plus

Tu peux avoir plusieurs formatages sur la même cellule et j'ai modifié le code ci-joint en ce sens.
Cependant, il te faut savoir que même si la mise en forme se fait avec le calcul de la formule, les cellules modifiables ne peuvent être que des cellules de texte non résultat de formule. Par contre si le résultat change, l'ancienne mise en forme ne change pas : faudrait-il remettre à normal ?

Code:

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
Private Sub Worksheet_Calculate()
Const nbf = 8   ' nombre de formats à adapter
Dim idx As Integer, tdc As Long
tdc = Application.Calculation
Application.Calculation = xlCalculationManual
ReDim cdf(1 To nbf, 1 To 3)
If [F1] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B4": cdf(idx, 2) = "F1"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F1] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F1"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F2] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F2"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F2] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F3"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
For idx = 1 To UBound(cdf)
    If cdf(idx, 1) <> "" And cdf(idx, 3) > 0 Then
        With ActiveSheet.Range(cdf(idx, 1)).Characters(cdf(idx, 3), Len(Range(cdf(idx, 2)))).Font
          .ColorIndex = 3 'rouge
          .Bold = True 'gras
          .Size = 20
        End With
    End If
Next idx
Application.Calculation = tdc
End Sub

Tu as dans ce code 3 mises en forme sur B14.

04/12/2019, 09h21
lmc71

1 pièce(s) jointe(s)

Bonjour,
J'ai essayer ton dernier code (fichier joint) et comme tu le dis ce n'est pas des plus concluant. Car même en reformant le cellule B14 l'effet n'est pas réel.
Je pense qu'il faut laisser le dossier en l'état.......
Cordialement

Bonjour,

Citation:

Envoyé par lmc71

comme tu le dis ce n'est pas des plus concluant.

Voilà le code en ne mettant en valeur que les cellules qui correspondent :

Code:

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
Private Sub Worksheet_Calculate()
Const nbf = 8   ' nombre de formats à adapter
Dim idx As Integer, tdc As Long
[B14].Value = [A2].Value
tdc = Application.Calculation
Application.Calculation = xlCalculationManual
ReDim cdf(1 To nbf, 1 To 3)
If [F1] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B4": cdf(idx, 2) = "F1"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F1] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F1"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F2] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F2"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
If [F3] <> "" Then
    idx = idx + 1: cdf(idx, 1) = "B14": cdf(idx, 2) = "F3"
    cdf(idx, 3) = InStr(Range(cdf(idx, 1)), Range(cdf(idx, 2)))
End If
For idx = 1 To UBound(cdf)
    If cdf(idx, 1) <> "" Then
        With ActiveSheet.Range(cdf(idx, 1)).Font
              .Color = 0  ' noir
              .Bold = False 'gras
              .Size = 11
            End With
    End If
Next idx
For idx = 1 To UBound(cdf)
    If cdf(idx, 1) <> "" And cdf(idx, 3) > 0 Then
        With ActiveSheet.Range(cdf(idx, 1)).Characters(cdf(idx, 3), Len(Range(cdf(idx, 2)))).Font
          .ColorIndex = 3 'rouge
          .Bold = True 'gras
          .Size = 20
        End With
    End If
Next idx
Application.Calculation = tdc
End Sub

Pour utiliser des cellules formulées comme ton A2, il suffit de rajouter en début de module la copie valeur de la cellule avec formule

Code:

[B14].Value = [A2].Value

Bonjour

Une autre manière de formater les chiffres dans une phrase

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Calculate()
 
[B14] = [A2]
Formatage [B14]
End Sub
 
Private Sub Formatage(Target As Range)
Dim i As Integer, N As Integer
Dim Tb
 
Tb = Split(Target)
For i = 0 To UBound(Tb)
    If Val(Tb(i)) <> 0 Then
        With Target.Characters(N + 1, Len(Tb(i))).Font
            .ColorIndex = 3                                'rouge
            .Bold = True                                   'gras
            .Size = 20
        End With
    End If
    N = N + Len(Tb(i)) + 1
Next i
End Sub

Ou simplement

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Calculate()
 
Application.ScreenUpdating = False
[B14] = [A2]
Formatage [B14]
End Sub
 
Private Sub Formatage(Target As Range)
Dim Tmp As String
Dim i As Integer
 
Tmp = Target.Value
For i = 1 To Len(Tmp)
    If IsNumeric(Mid(Tmp, i, 1)) Then
        With Target.Characters(i, 1).Font
            .ColorIndex = 3                                'rouge
            .Bold = True                                   'gras
            .Size = 20
        End With
    End If
Next i
End Sub

04/12/2019, 17h58
lmc71

Bonjour Mercatog, Anasecu
J'ai essayé les codes de Mercatog et placés dans mon fichier initial et tout fonctionne très bien.
Je conserve néanmoins les codes d'Anasecu pour mon apprentissage personnel.
Je tiens à vous remercier tous les deux pour votre obligeance qui dénote votre bienveillance.
Cordialement
Je vais mettre affaire résolue.
Encore merci