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é !
Bonjour,
ce qui donne:
With Selection.Find .ClearFormatting .Text = "!" .Execute Forward:=True, Wrap:=wdFindContinue Selection.Font.ColorIndex = wdRed End With End Sub
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
supprime ces 3 lignes qui sont avant:
Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.HomeKey Unit:=wdStory