Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

formatage d'un chiffre d'une phrase [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut formatage d'un chiffre d'une phrase
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  2. #2
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    649
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 649
    Points : 1 054
    Points
    1 054
    Par défaut
    Bonjour,
    Citation Envoyé par lmc71 Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  3. #3
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  4. #4
    Membre éprouvé Avatar de Transitoire
    Homme Profil pro
    Auditeur informatique
    Inscrit en
    décembre 2017
    Messages
    595
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 65
    Localisation : France, Alpes Maritimes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Auditeur informatique

    Informations forums :
    Inscription : décembre 2017
    Messages : 595
    Points : 1 186
    Points
    1 186
    Par défaut
    Bonjour,
    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
    On a deux vies, la deuxième commence quand on se rend compte qu'on n'en a qu'une.
    Confucius

  5. #5
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    649
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 649
    Points : 1 054
    Points
    1 054
    Par défaut
    Bonjour lmc71,
    Citation Envoyé par lmc71 Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  6. #6
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  7. #7
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    649
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 649
    Points : 1 054
    Points
    1 054
    Par défaut
    re
    Citation Envoyé par lmc71 Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
            Set c1 = [F1]: Set c2 = [A2]: Set c3 = [B14]
    Il te faut corriger et remettre ton [B4]
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
            Set c1 = [F1]: Set c2 = [A2]: Set c3 = [B4]

  8. #8
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut
    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

  9. #9
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    649
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 649
    Points : 1 054
    Points
    1 054
    Par défaut
    Bonsoir lmc71,
    Citation Envoyé par lmc71 Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  10. #10
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut
    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
    Fichiers attachés Fichiers attachés

  11. #11
    Membre éprouvé
    Inscrit en
    septembre 2007
    Messages
    649
    Détails du profil
    Informations forums :
    Inscription : septembre 2007
    Messages : 649
    Points : 1 054
    Points
    1 054
    Par défaut
    Bonjour,
    Citation Envoyé par lmc71 Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    [B14].Value = [A2].Value

  12. #12
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    9 409
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : juillet 2008
    Messages : 9 409
    Points : 31 769
    Points
    31 769
    Par défaut
    Bonjour

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

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Cordialement.
    J'utilise toujours le point comme séparateur décimal dans mes tests.

  13. #13
    Expert éminent sénior Avatar de mercatog
    Homme Profil pro
    Inscrit en
    juillet 2008
    Messages
    9 409
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : juillet 2008
    Messages : 9 409
    Points : 31 769
    Points
    31 769
    Par défaut
    Ou simplement
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Cordialement.
    J'utilise toujours le point comme séparateur décimal dans mes tests.

  14. #14
    Membre régulier

    Homme Profil pro
    retraité
    Inscrit en
    décembre 2014
    Messages
    202
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : décembre 2014
    Messages : 202
    Points : 91
    Points
    91
    Billets dans le blog
    1
    Par défaut
    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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [MySQL] Extraire le texte d'une phrase sans les chiffres
    Par lordlifen dans le forum PHP & Base de données
    Réponses: 1
    Dernier message: 03/09/2010, 14h25
  2. [Toutes versions] sélectionner uniquement les chiffres dans une phrase ?
    Par bourrico dans le forum VBA Word
    Réponses: 1
    Dernier message: 24/09/2009, 01h12
  3. Affichage des chiffres dans une phrases arabe
    Par omda dans le forum Oracle
    Réponses: 4
    Dernier message: 30/09/2005, 14h36
  4. [RegEx] supprimer les chaine à trois caracteres d'une phrase
    Par abj8077 dans le forum Langage
    Réponses: 3
    Dernier message: 21/10/2004, 15h48
  5. DBGrid: formatage de l'affichage d'une colonne
    Par SAca dans le forum Bases de données
    Réponses: 6
    Dernier message: 14/05/2004, 18h33

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo