Microsoft 365 Mettre en gras uniquement les chiffres

[pat66]

Bonjour le forum,

je sais pas si c'est possible, mais je souhaiterai pouvoir mettre en gras uniquement les chiffres contenu dans une forme

ci joint un fichier avec un exemple

merci d'avance pour vos lumières

pa66

 

[TooFatBoy]

Bonjour,

Avec un bout de code VBA on peut modifier l'aspect visuel d'un texte contenu dans une cellule, à condition qu'il n'y ait pas de formule dans ladite cellule.

Une petite recherche sur le forum te donnera des exemples.

 

[pat66]

re,

merci pour ta réponse, mais ce n'est pas l'aspect visuel de la cellule que je souhaite modifier, c'est l'aspect visuel du texte du rectangle 2

merci

 

[crocrocro]

Bonjour
voici le code qui répond au besoin

Sub ChiffresGras()
    With ActiveSheet.Shapes("Rectangle 1")
        For i = 1 To Len(.TextFrame2.TextRange.Text)
            'MsgBox .TextFrame2.TextRange.Characters(i, 1)
            If IsNumeric(.TextFrame2.TextRange.Characters(i, 1)) Then
                .OLEFormat.Object.Characters(i, 1).Font.Bold = True
            Else
                .OLEFormat.Object.Characters(i, 1).Font.Bold = False
            End If
        Next i
    End With
End Sub

 

[job75]

Bonjour à tous,

Cette macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x$, y$
x = Format([C7], "0.00 €")
y = "ceci est une promotion "
With Shapes("Rectangle 2").TextFrame
    .Characters.Text = y & x
    With .Characters(Len(y), Len(x) + 1).Font
        .Color = vbRed
        .Bold = True
    End With
End With
End Sub

s'exécute quand on modifie la cellule C7.

A+

 

[TooFatBoy]

merci pour ta réponse, mais ce n'est pas l'aspect visuel de la cellule que je souhaite modifier

Ah oui, effectivement :

je souhaiterai pouvoir mettre en gras uniquement les chiffres contenu dans une cellule

Sur ce, bon après-midi ensoleillé
🌞 🌻 🚤​

 

[pat66]

Ah oui, effectivement :

Désolé, je vais corriger, mais je pensais que le fichier était explicite

bon après midi

Sur ce, bon après-midi ensoleillé
🌞 🌻 🚤​

 

[TooFatBoy]

Étant sur mon tél, je n'ai pas ouvert le fichier. 😔


Attention aussi de ne pas inclure du texte que je n'ai pas écrit quand tu me cites. 😉

 

[job75]

Moi j'ai commencé l'après-midi en modifiant légèrement mon post #5 🙄

 

[pat66]

Bonjour le fil,

un grand merci à tous, je teste vos différentes solutions et revient vous.....

 

[AtTheOne]

Bonjour à toutes & à tous,
Bonjour @pat66 et tous les participants !
J'ai souvent l'impression de me répéter en le disant mais "j'arrive un peu tard !"
Je te propose une solution avec le prix un préfixe et un suffixe et des mises en forme du texte variées à alléger ou enrichir.

L'événement change de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

          If Not Intersect(Target, Union([prix], [Préfixe], [Suffixe])) Is Nothing Then ModifAffiche

End Sub

Le code de modification de la forme :

Sub ModifAffiche()

     Dim shp As Shape
     LePrix = Trim(Format([prix], "# ###.00 €"))
     Longueur = Len(LePrix)
     Début = Len([Préfixe]) + 2
    
     Set shp = Feuil1.Shapes("Affiche")
     With shp.TextFrame2.TextRange
          .Text = [Préfixe] & " " & LePrix & " " & [Suffixe]
          With .Characters(Début, Longueur).Font
               .Size = 24
               .Bold = msoCTrue
               .Italic = msoCTrue
               .Fill.ForeColor.RGB = RGB(0, 0, 255)
               .UnderlineStyle = msoUnderlineHeavyLine
          End With
     End With
 
 
End Sub

 

[pat66]

Bonsoir AtheOne,

intéressant ta solution, dans le cas ou le suffixe est un pourcentage (ex: 25%), comment le faire apparaitre dans l'image à la suite du préfixe

merci

 

[AtTheOne]

Re,
Bon, tu recomposes le texte à ta guise, tu peux même ajouter d'autre partie de texte, tu as le principe et tu peux assez facilement l'adapter.
Pour le pourcentage voilà la modif (je suppose qu'après tu vas me demander de rehausser aussi le pourcentage et de mettre un prix barré, mais je te laisse chercher un peu 😉).

Sub ModifAffiche()

     Dim shp As Shape
     LePrix = Trim(Format([prix], "# ###.00 €"))
     Longueur = Len(LePrix)
    
     Texte = [Préfixe] & " " & Format([Suffixe], "0%")
     Début = Len(Texte) + 2
    
     Set shp = Feuil1.Shapes("Affiche")
     With shp.TextFrame2.TextRange
          .Text = Texte & " " & LePrix
          With .Characters(Début, Longueur).Font
               .Size = 24
               .Bold = msoCTrue
               .Italic = msoCTrue
               .Fill.ForeColor.RGB = RGB(0, 0, 255)
               .UnderlineStyle = msoUnderlineHeavyLine
          End With
     End With

End Sub

Voir fichier joint
À bientôt

 

[pat66]

Bonjour le forum,

bonjour le fil,
bonjour crocrocro
bonjour job75
bonjour AtTheOne

Ce n'était pas prévu, mais j'ai du ajouter des valeurs numériques à la macro,

Cela fait 2 jours que je galère, j'ai bien essayer avec les solutions de crocrocro et job75, mais je n'y arrive pas, quelqu'un aurait t'il la gentillesse de corriger mes erreurs.
j'ai mis un exemple de ce que je souhaiterai avoir visuellement

un grand merci d'avance

 

[job75]

Bonjour pat66,

Le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v1$, L1%, v2$, L2%, v3$, L3%, x$, i%, L%
v1 = [C7].Text: L1 = Len(v1)
v2 = [C11].Text: L2 = Len(v2)
v3 = [C9].Value: L3 = Len(v3)
x = "Article en promotion à " & v1 & ", soit " & v2 & " en " & v3 & " mensualité" & IIf(v3 > 1, "s", "")
With Shapes("Rectangle 1").TextFrame
    .Characters.Text = x
    For i = 1 To Len(x)
        L = 0
        If Mid(x, i, L3) = v3 Then L = L3
        If Mid(x, i, L1) = v1 Then L = L1
        If Mid(x, i, L2) = v2 Then L = L2
        If L Then
            With .Characters(i, L).Font
                .Color = vbRed
                .Bold = True
            End With
        End If
    Next i
End With
End Sub

La macro se déclenche quand on modifie ou valide une cellule quelconque.

A+