Macro pour replacer mot avec nouvelle mise en forme

[plopla]

Bonjour,
Je vous écris car je suis confronté à un problème que je ne parviens pas a résoudre:

Je désire pouvoir remplacer une partie du contenu d'une cellule par le contenu d'une autre en gardant la mise en forme du nouveau mot mais sans changer toute la mise en forme de la cellule d'origine. (c'est ce qui m'arrive si j'utilise la fonction recherche et remplacer).

Par exemple ce que je veux faire c'est changer "normalindice" par "normal[SUB]indice[/SUB]".

J'ai vu qu'une macro similaire avait été faite (sauf qu'elle garde justement la mise en forme de la cellule d'origine:
https://www.excel-downloads.com/thr...s-changer-les-couleurs-mises-en-forme.174214/

J'espère que vous pourrez m'aider,
Merci d'avance

 

[Staple1600]

Re : Macro pour replacer mot avec nouvelle mise en forme

Bonjour à tous


popla( bienvenue sur XLD)
Code adapté de l’enregistreur de macros... 😉

Sub Macro1()
ActiveCell.Characters(Start:=7, Length:=6).Font.Subscript = True
End Sub

EDITION: Bonjour mapomme 🙄

 

[mapomme]

Re : Macro pour replacer mot avec nouvelle mise en forme

Bonjour plopla 🙂

En adaptant la macro de 2011...

 

[plopla]

Re : Macro pour replacer mot avec nouvelle mise en forme

Bonjour,
Merci beaucoup pour votre aide !

J'ai encore une petite question:
actuellement la macro de mapomme change le format de tout ce que je lui demande en indice. Est il possible d'avoir la possibilité de chercher un mot et le remplacer par le contenu d'une autre cellule (un peu comme dans la macro de 2011 mais en changeant justement la mise en forme) ?

J'espère que j'ai été clair,
Et je vous remercie d'avance

 

[Staple1600]

Re : Macro pour replacer mot avec nouvelle mise en forme

[aparté]
J'ai pourtant pas oublier de me brosser les dents.
La douche est prise également.
Mais bon, je dois être invisible 😉
[/aparté]

 

[plopla]

Re : Macro pour replacer mot avec nouvelle mise en forme

Re bonjour,

Je rajoute quelques info:
J'ai par exemple le mot FICAAA et j'aimerais le remplacer par FICA[SUB]AA[/SUB]
Avec la dernière macro de mapomme ça fait FIC[SUB]AA[/SUB]A
C'est pourquoi j'aimerais pouvoir faire une réelle recherche et pouvoir remplacer le mot en question par le contenu d'un autre cellule contenant le mot avec la bonne mise en forme.

Merci d'avance

 

[Staple1600]

Re : Macro pour replacer mot avec nouvelle mise en forme

Re

plopla
Tu as compris le sens des mots Start et Length dans le code?
(voir mon premier message posté à 12h03)

 

[plopla]

Re : Macro pour replacer mot avec nouvelle mise en forme

Staple1600,

Tu as compris le sens des mots Start et Length dans le code?

Non, je ne l'ai pas compris. J'ai utilisé la macro de mapomme (message de 16h13) car je ne sais pas ou insérer le code que tu m'as transmis.
Mais si tu me dis où l’insérer je veux bien essayer...

 

[Staple1600]

Re : Macro pour replacer mot avec nouvelle mise en forme

Re

J'en déduis que tu n'as su tester la macro que je t'ai proposé à 12h03?
Tu sais aller dans VBE? (touches ALT+F11)
Un fois que tu y es tu copies/colles le code VBA à tester.
Ci-dessous tutoriel
Exécuter une macro - Excel - Office.com

Question subsidiaire: quel est ton niveau de maitrise de VBA ?

 

[plopla]

Re : Macro pour replacer mot avec nouvelle mise en forme

Re
J'en déduis que tu n'as su tester la macro que je t'ai proposé à 12h03?

Question subsidiaire: quel est ton niveau de maitrise de VBA ?

Je ne 'avais pas testé car je ne savais pas comment faire. Mais je viens de le faire ce qui d'ailleurs m'a permis de comprendre le code: à partir du 6° caractère ça met les 7 suivant en indice.
Ce code est intéressant mais il ne me permet pas tout à fait de faire ce que je veux, car contrairement à celui de mapome il est assez limité...

Mon niveau en VBA est nul mais j'arrive à comprendre un peu ce que je fais (ou pas)

 

[Staple1600]

Re : Macro pour replacer mot avec nouvelle mise en forme

Re

Ce code est intéressant mais il ne me permet pas tout à fait de faire ce que je veux, car contrairement à celui de mapome il est assez limité...

Je n'ai jamais dit que ma proposition était une solution 100% opérationnelle.
Elle avait vocation à être testée ...pour commencer 🙄 puis susciter curiosité et envie pour aller plus loin.
(toujours cette histoire d'inciter le demandeur à mettre les mains dans le cambouis 😉)

Donc limitons-nous alors à attendre le retour de ma pomme 😉.

 

[mapomme]

Re : Macro pour replacer mot avec nouvelle mise en forme

Bonsoir plopla, Staple1600 🙂

Un essai dans le fichier joint.

Essai raté qui ne tenait pas compte des minuscules et majuscules de la mise en forme souhaitée.

 

[mapomme]

Re : Macro pour replacer mot avec nouvelle mise en forme

(re) Bonsoir à tous,

Un essai v3 qui devrait prendre en compte les majuscules et minuscules du format souhaité.

• Cliquer sur le bouton "Remplacer des caractères"
• Sélectionner la zone dans laquelle les remplacements devront se faire (par ex: A5:A8)
• sélectionner ensuite la cellule contenant le texte à rechercher avec la mise en forme souhaitée (par ex: B2)

nota: Dans cette version, la casse n'est pas pris en compte pour la recherche du mot. Si vous voulez prendre en compte la casse remplacez le paramètre vbTextCompare par le paramètre vbBinaryCompare.

Edit: version v3.1 à cause d'un petit oubli de modif de paramètre vbBinaryCompare en vbTextCompare 😱

Le code est dans module1 (avec quelques commentaires):

Sub SubstituerFormatTexte()
Dim rgOu As Range, xCell As Range, Quoi As Range, N&, i&

On Error GoTo FIN
  'zone de recherche
  Set rgOu = Application.InputBox(prompt:="Sélectionner la zone de recherche:", Type:=8)
  'cellule où se trouve le texte et le format à apppliquer
  Set Quoi = Application.InputBox(prompt:="Cellule contenant l'expression formatée finale?", Type:=8)
  If Quoi Is Nothing Then Exit Sub
  If IsEmpty(Quoi) Then Exit Sub
  If Not Intersect(rgOu, Quoi) Is Nothing Then Exit Sub
  Set Quoi = Quoi(1, 1)

Application.ScreenUpdating = False
On Error Resume Next
  For Each xCell In rgOu
    'pour chaque cellule de la zone de recherche
    'recherche du mot à formater
    N = InStr(1, xCell, Quoi, vbTextCompare)
    If N > 0 Then
    'le mot est dans la cellule
      'boucle sur chaque apparition du mot dans la cellule
      Do
        ' boucle sur chaque du mot trouvé
        For i = 1 To Len(Quoi)
          'test sur le caractère final, est il en en majuscule ou non ?
          If Asc(Quoi.Characters(i, 1).Text) = Asc(UCase(Quoi.Characters(i, 1).Text)) Then
            'il est en majuscule
            xCell.Characters(N + i - 1, 1).Text = UCase(Quoi.Characters(i, 1).Text)
          Else
            'il n'est pas en majuscule donc il est en minuscule
            xCell.Characters(N + i - 1, 1).Text = LCase(Quoi.Characters(i, 1).Text)
          End If
          'on applique au caractère de la cellule le format du même caractère dans Quoi
          xCell.Characters(N + i - 1, 1).Font.Bold = Quoi.Characters(i, 1).Font.Bold
          xCell.Characters(N + i - 1, 1).Font.Color = Quoi.Characters(i, 1).Font.Color
          xCell.Characters(N + i - 1, 1).Font.ColorIndex = Quoi.Characters(i, 1).Font.ColorIndex
          xCell.Characters(N + i - 1, 1).Font.FontStyle = Quoi.Characters(i, 1).Font.FontStyle
          xCell.Characters(N + i - 1, 1).Font.Italic = Quoi.Characters(i, 1).Font.Italic
          xCell.Characters(N + i - 1, 1).Font.Name = Quoi.Characters(i, 1).Font.Name
          xCell.Characters(N + i - 1, 1).Font.Size = Quoi.Characters(i, 1).Font.Size
          xCell.Characters(N + i - 1, 1).Font.Strikethrough = Quoi.Characters(i, 1).Font.Strikethrough
          xCell.Characters(N + i - 1, 1).Font.Subscript = Quoi.Characters(i, 1).Font.Subscript
          xCell.Characters(N + i - 1, 1).Font.Superscript = Quoi.Characters(i, 1).Font.Superscript
          xCell.Characters(N + i - 1, 1).Font.ThemeColor = Quoi.Characters(i, 1).Font.ThemeColor
          xCell.Characters(N + i - 1, 1).Font.ThemeFont = Quoi.Characters(i, 1).Font.ThemeFont
          xCell.Characters(N + i - 1, 1).Font.TintAndShade = Quoi.Characters(i, 1).Font.TintAndShade
          xCell.Characters(N + i - 1, 1).Font.Underline = Quoi.Characters(i, 1).Font.Underline
        'on passe au caractère suivant
        Next i
          'on cherche l'apparition du mot Quoi dans le reste de la cellule
          N = InStr(N + Len(Quoi), xCell, Quoi, vbTextCompare )
          'si le mot n'y figure plus, on sort de la boucle sur la cellule
      Loop Until N = 0
    End If
  'on passe à la cellule suivante
  Next xCell

FIN:
Application.ScreenUpdating = True
End Sub

 

[plopla]

Re : Macro pour replacer mot avec nouvelle mise en forme

ReBonsoir,

Merci beaucoup pour votre aide. Pour une raison qui m’échappe, quand je teste la macro avec votre exemple tout fonctionne; mais quand je la teste sur ce dont j'ai besoin ça ne marche plus.

Sur le fichier j'ai rajouté des éléments réels surs lesquels je travaille. Il y a d'une part l'état actuel des choses et d'autre part certains mots avec le format désiré.

J'espère que vous pourrez m'aider,
et je vous remercie d'avance pour votre aide.

note: les exemples que j'ai donné ne sont qu'une infinitisme partie du fichier sur lequel je travaille...

 

[mapomme]

Re : Macro pour replacer mot avec nouvelle mise en forme

Bonjour à tous,

Une version 4 corrigée. Je n'avais pas prêté attention au fait que les propriétés exposant et indice () sont liées. La modification d'une de ces propriétés peut modifier l'autre (à posteriori évident après trouvé l'erreur 😛)

Dans cette version, vous pouvez sélectionner la plage des cellules de tous les textes "cibles" (ex: C9:C14)