Sujet Précédent Sujet Suivant

Macro word changer couleur ponctuation texte

yannours Messages postés 3 Date d'inscription dimanche 16 avril 2023 Statut Membre Dernière intervention 17 avril 2023 - Modifié le 16 avril 2023 à 16:53
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 17 avril 2023 à 16:40

Bonjour tous !

voilà maintenant une journée que je galère pour essayer d'inclure dans une macro existante que j'ai écrit il y a pas mal de temps de cela une nouvelle commande qui serait de mettre une couleur sur les ponctuations dans Word par exemple mettre en rouge tous les points d'exclamation ou en bleu tous les points, et je n'y arrive pas.

Merci par avance de ce que vous pourrez faire pour moi.

A voir également:

Code source
Roulettechat texte - Forum Visual Basic
Inverser couleur photoshop - Forum Visual Basic
Inverser les couleurs d'une image 16x16 ✓ - Forum Visual Basic 6
Inversion de couleur ✓ - Forum Visual Basic 6
Macro catia - Forum VBA Office (Excel, Word ...)

2 réponses

Réponse 1 / 2

yannours Messages postés 3 Date d'inscription dimanche 16 avril 2023 Statut Membre Dernière intervention 17 avril 2023
17 avril 2023 à 09:55

Voici la macro que je souhaiterais compléter. Il y a déjà une partie dans le codage concernant la ponctuation qui fonctionne mais j'aimerais donc lui rajouter des attributs de couleurs différents pour chaque élément de ponctuation désigné.

Merci à la communauté !

Réponse 2 / 2

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137
17 avril 2023 à 12:08

Bonjour,

Voir ceci

ce qui donne:

With Selection.Find
 .ClearFormatting
 .Text = "!"
 .Execute Forward:=True, Wrap:=wdFindContinue
 Selection.Font.ColorIndex = wdRed
End With
End Sub

yannours Messages postés 3 Date d'inscription dimanche 16 avril 2023 Statut Membre Dernière intervention 17 avril 2023
17 avril 2023 à 14:34

merci pour ce retour,

après essai d'intégration à ma macro cela ne fonctionne pas.

Voici la macro complète avec la partie rajoutée en gras, je ne comprends pas où cela bloque?!

Sub NumGKL16()
'
' NumGKL16 Macro
'
' Effacer la mise en forme
'

' Supprime tous les liens hypertexte et les signets
Dim hlien As Hyperlink
Dim Signet As Bookmark

For Each hlien In ActiveDocument.Hyperlinks
With hlien
hlien.Delete
End With
Next
For Each Signet In ActiveDocument.Bookmarks
With Signet
Signet.Delete
End With
Next

' Appliquer le style Normal ï¿½ tout le texte
Selection.WholeStory
Selection.ClearFormatting

WordBasic.FormatStyle name:="Normal", NewName:="", BasedOn:="", NextStyle _
:="", Type:=0, FileName:="", Link:=""
With ActiveDocument.Styles("Normal").Font
.name = "Luciole"
.size = 16
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 0
.Animation = wdAnimationNone
End With
With ActiveDocument.Styles("Normal").ParagraphFormat
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 32
.Alignment = wdAlignParagraphJustify
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = CentimetersToPoints(1.27)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
End With
ActiveDocument.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = _
False
ActiveDocument.Styles("Normal").ParagraphFormat.TabStops.ClearAll
With ActiveDocument.Styles("Normal").ParagraphFormat
With .Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
.Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Borders(wdBorderTop).LineStyle = wdLineStyleNone
.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
With .Borders
.DistanceFromTop = 1
.DistanceFromLeft = 4
.DistanceFromBottom = 1
.DistanceFromRight = 4
.Shadow = False
End With
End With
ActiveDocument.Styles("Normal").LanguageID = wdFrench
ActiveDocument.Styles("Normal").NoProofing = False
ActiveDocument.Styles("Normal").Frame.Delete

Selection.WholeStory
Selection.Style = ActiveDocument.Styles("Normal")

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.HomeKey Unit:=wdStory

With Selection.Find
 .ClearFormatting
 .Text = "!"
 .Execute Forward:=True, Wrap:=wdFindContinue
 Selection.Font.ColorIndex = wdRed
End With

' Saut de ligne manuel

With Selection.Find
.Text = "^l"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Trait d'union conditionnel

With Selection.Find
.Text = "^-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Tabulation

With Selection.Find
.Text = "^t"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Tirets cadratin et semi-cadratin

With Selection.Find
.Text = "^+"
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

With Selection.Find
.Text = "ï¿½"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "^="
.Replacement.Text = "-"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Espace + (marque de paragraphe) + espace

With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "^p "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Guillemets ï¿½ ï¿½

With Selection.Find
.Text = " ï¿½"
.Replacement.Text = "^sï¿½ "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "ï¿½ "
.Replacement.Text = " ï¿½^s"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Boucle de suppression des espaces doubles

Boucle:
Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = " "
End With
If Selection.Find.Found = True Then
GoTo Boucle:
End If

Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Parenthï¿½ses + Espace

With Selection.Find
.Text = "( "
.Replacement.Text = "("
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " )"
.Replacement.Text = ")"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Caractï¿½res ; : ? ! . , prï¿½cï¿½dï¿½s d'une espace

With Selection.Find
.Text = " ."
.Replacement.Text = ". "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = " ,"
.Replacement.Text = ", "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = ":"
.Replacement.Text = "^s: "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = ";"
.Replacement.Text = "^s; "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "!"
.Replacement.Text = "^s! "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "?"
.Replacement.Text = "^s? "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "..."
.Replacement.Text = "ï¿½"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "ï¿½"
.Replacement.Text = "ï¿½ "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Marque de paragraphe + Trait d'union + Espace

With Selection.Find
.Text = "^p- "
.Replacement.Text = "^p-"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Apostrophe

With Selection.Find
.Text = "ï¿½"
.Replacement.Text = "'"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Remplacer (oe)

With Selection.Find
.Text = "oe"
.Replacement.Text = "ï¿½"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Boucle de suppression des espaces devant des espaces insï¿½cables ^s
Boucle3:
Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " ^s"
.Replacement.Text = "^s"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = " ^s"
End With
If Selection.Find.Found = True Then
GoTo Boucle3:
End If

Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Boucle de suppression des espaces aprï¿½s des espaces insï¿½cables ^s
Boucle4:
Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^s "
.Replacement.Text = "^s"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = "^s "
End With
If Selection.Find.Found = True Then
GoTo Boucle4:
End If

Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Boucle de suppression des espaces doubles
Boucle2:
Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection.Find
.Text = " "
End With
If Selection.Find.Found = True Then
GoTo Boucle2:
End If

Selection.HomeKey Unit:=wdStory
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Espace + (marque de paragraphe) + espace

With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = "^p "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Mettre un espace aprï¿½s le tiret de dï¿½but de ligne

With Selection.Find
.Text = "^p-"
.Replacement.Text = "^p-^s"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Supprime l'espace aprï¿½s un saut de page

With Selection.Find
.Text = "^m "
.Replacement.Text = "^m"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

' Gestion des lien http
With Selection.Find
.Text = "http^s: //"
.Replacement.Text = "http://"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

End Sub

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 137 > yannours Messages postés 3 Date d'inscription dimanche 16 avril 2023 Statut Membre Dernière intervention 17 avril 2023
17 avril 2023 à 16:40

supprime ces 3 lignes qui sont avant:

   Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.HomeKey Unit:=wdStory

Discussions similaires

correcteur de ponctuation

Convertir un code hexadecimal en couleur

Couleur de fond d'une cellule excel

coder un Tchat comme roulettechat.fr/chat/texte.php

[Photoshop] : Image noir et blanc en image blanc et noir ?

Votre réponse

Discussions similaires