J'ai Word 2007 et avec un ou deux bidouillages, ça a l'air de marcher. J'ai aussi changé le raccourci $ (dans ma macro il permet d'ajouter [/spoiler][spoiler] et donc de couper le texte en plusieurs parties qu'on peut ainsi poster sur le forum dans des posts différents). J'ai mi mes propres textes et couleurs (même si j'ai laissé les noms d'origine des "sub"). Enfin j'ai supprimé l'italique et le barré qui ne m'intéressaient pas. Sinon tout est copié de Racoon.
La voici :
Sub Merci_Raccoon()
Application.ScreenUpdating = False
Dim MyText As String
Dim MyRange As Object
Set MyRange = ActiveDocument.Range
MyText = vbCrLf & vbCrLf & "Ceci est ma bêta-lecture. N'oubliez pas que ce n'est que mon avis et que d'autres lecteurs pourraient voir le texte différemment." & vbCrLf & "Mes codes de couleurs :" & vbCrLf & "[color=#0000FF]bleu : style (orthographe, grammaire, mot impropre, répétitions, manque de clarté, syntaxe…)[/color]" & vbCrLf & "[color=#000000]vert: personnages (problèmes de caractérisation, crédibilité, incohérences dans le comportement…)[/color]" & vbCrLf & "[color=#FF0000]rouge : problème d'intrigue (incohérences, construction, POV,…)[/color]" & vbCrLf & "[color=#FF4000]violet : autres commentaires[/color]" & vbCrLf & vbCrLf & vbCrLf & "[spoiler]" & vbCrLf
MyRange.InsertBefore (MyText)
ConvertBold
ConvertUnderline
ConvertColorBleu
ConvertColorVert
ConvertColorOrange
ConvertColorCyan
Remplace_dollar
Remplace_detoile
Remplace_etoile
Remplace_diese
Remplace_pct
Remplace_arob
Remplace_ouvert
Remplace_ferme
Remplace_anti
Remplace_para
ActiveDocument.Select
pos = Selection.EndKey(Unit:=wdLine, Extend:=wdMove)
MyText = vbCrLf & "[/spoiler]" & vbCrLf & vbCrLf & "[spoiler]" & "Impression générale :" & vbCrLf & vbCrLf & "[/spoiler]"
Selection.InsertAfter (MyText)
ActiveDocument.Content.Copy
Call Selection.Find.ClearFormatting
Application.ScreenUpdating = True
End Sub
Private Sub SetupFindObject()
ActiveDocument.Select
With Selection.Find
.ClearFormatting
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue
End With
End Sub
Private Sub ConvertBold()
Call SetupFindObject
Selection.Find.Font.Bold = True
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Bold = False
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr Then
.Font.Bold = False
With Selection
.InsertBefore "[color=#000000][b]"
.Collapse (wdCollapseEnd)
.InsertAfter "[/b][/color]"
End With
' SurroundSelectionWithTag ("b")
End If
End With
Loop
End Sub
Private Sub ConvertUnderline()
Call SetupFindObject
Selection.Find.Font.Underline = True
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Underline = False
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr And .Range.Hyperlinks.Count = 0 Then
.Font.Underline = False
With Selection
.InsertBefore "[color=#000000][u]"
.Collapse (wdCollapseEnd)
.InsertAfter "[/u][/color]"
End With
'SurroundSelectionWithTag ("u")
End If
End With
Loop
End Sub
Private Sub ConvertColorBleu()
Call SetupFindObject
Selection.Find.Font.Color = RGB(0, 112, 192)
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Color = wdColorBlack
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr Then
.Font.Color = wdColorBlack
With Selection
.InsertBefore "[color=#0070C0]("
.Collapse (wdCollapseEnd)
.InsertAfter ")[/color]"
End With
End If
End With
Loop
End Sub
Private Sub ConvertColorVert()
Call SetupFindObject
Selection.Find.Font.Color = RGB(0, 176, 80)
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Color = wdColorBlack
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr Then
.Font.Color = wdColorBlack
With Selection
.InsertBefore "[color=#00B050]("
.Collapse (wdCollapseEnd)
.InsertAfter ")[/color]"
End With
End If
End With
Loop
End Sub
Private Sub ConvertColorOrange()
Call SetupFindObject
Selection.Find.Font.Color = RGB(255, 0, 0)
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Color = wdColorBlack
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr Then
.Font.Color = wdColorBlack
With Selection
.InsertBefore "[color=#FF0000]("
.Collapse (wdCollapseEnd)
.InsertAfter ")[/color]"
End With
End If
End With
Loop
End Sub
Private Sub ConvertColorCyan()
Call SetupFindObject
Selection.Find.Font.Color = RGB(112, 48, 160)
Do While Selection.Find.Execute
With Selection
If InStr(1, .Text, vbCr) Then
.Font.Color = wdColorBlack
.Collapse
.MoveEndUntil vbCr
End If
If Not .Text = vbCr Then
.Font.Color = wdColorBlack
With Selection
.InsertBefore "[color=#7030A0]("
.Collapse (wdCollapseEnd)
.InsertAfter ")[/color]"
End With
End If
End With
Loop
End Sub
Private Sub Remplace_dollar()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "$"
.Replacement.Text = vbCr & vbCr & "[/spoiler]" & vbCr & vbCr & "[spoiler]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_detoile()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "**"
.Replacement.Text = "[color=#FF00BF]~ J'adore ce passage
~[/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_etoile()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "*"
.Replacement.Text = "[color=#FF00BF]~ j'aime ce passage
~[/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_diese()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "+"
.Replacement.Text = "[color=#BF00BF][Passage un peu lourd: à reformuler][/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_pct()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "%"
.Replacement.Text = "[color=#BF00BF][Tic de langage/Formulation à prohiber dans une narration: enlever ou reformuler][/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_arob()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "@"
.Replacement.Text = "[color=#BF00BF][Peu élégant: à modifier][/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_ouvert()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<"
.Replacement.Text = "[color=#BF00BF]<Il manque une chose ici "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_ferme()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ">"
.Replacement.Text = " >[/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_anti()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "\"
.Replacement.Text = "[color=#BF00BF][Attention aux temps: Vérifier la chronologie des actions par rapport au temps principal de narration][/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Private Sub Remplace_para()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "§"
.Replacement.Text = "[color=#BF00BF][Répétition d'idées / redondance d'informations][/color]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Il est très important pour que ça fonctionne que les couleurs utilisées sur Word correspondent aux codes RGB (chez moi ce sont les couleurs standards : bleu (pas bleu clair), vert (pas vert clair), rouge et violet.
Si vous voulez me poser des questions...