markdown-to-word-macro

Sub ConvertirMarkdownVersStyle() ' ' Macro pour convertir le contenu Markdown en styles Word ' Créée pour transformer la syntaxe Markdown en formatage Word natif '

Dim doc As Document
Set doc = ActiveDocument

' Désactiver la mise à jour de l'écran pour améliorer les performances
Application.ScreenUpdating = False

' Sauvegarder la position du curseur
Dim originalRange As Range
Set originalRange = Selection.Range

' Sélectionner tout le document
doc.Range.Select

' Traitement des titres (# ## ### etc.)
Call TraiterTitres

' Traitement du texte en gras (**texte** ou __texte__)
Call TraiterGras

' Traitement du texte en italique (*texte* ou _texte_)
Call TraiterItalique

' Traitement du code inline (`code`)
Call TraiterCodeInline

' Traitement des listes à puces (- ou *)
Call TraiterListesPuces

' Traitement des listes numérotées (1. 2. etc.)
Call TraiterListesNumerotees

' Traitement des liens [texte](url)
Call TraiterLiens

' Traitement des blocs de code (```)
Call TraiterBlocsCode

' Restaurer la position du curseur
originalRange.Select

' Réactiver la mise à jour de l'écran
Application.ScreenUpdating = True

MsgBox "Conversion Markdown terminée !", vbInformation, "Conversion réussie"

End Sub

Sub TraiterTitres() Dim i As Integer Dim searchText As String Dim styleNom As String

' Traiter les titres de niveau 1 à 6
For i = 6 To 1 Step -1
    searchText = String(i, "#") & " "
    
    ' Définir le style correspondant
    Select Case i
        Case 1: styleNom = "Heading 1"
        Case 2: styleNom = "Heading 2"
        Case 3: styleNom = "Heading 3"
        Case 4: styleNom = "Heading 4"
        Case 5: styleNom = "Heading 5"
        Case 6: styleNom = "Heading 6"
    End Select
    
    ' Rechercher et remplacer
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = searchText & "*^p"
        .Replacement.Text = "\2^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Replacement.Style = styleNom
        .Execute Replace:=wdReplaceAll
    End With
Next i

End Sub

Sub TraiterGras() ' Traiter texte With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "**([!*]@)**" .Replacement.Text = "\1" .Replacement.Font.Bold = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = True .Execute Replace:=wdReplaceAll End With

' Traiter __texte__
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "__([!_]@)__"
    .Replacement.Text = "\1"
    .Replacement.Font.Bold = True
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

End Sub

Sub TraiterItalique() ' Traiter texte (mais pas texte) With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "([^*])*([!*]@)*([^*])" .Replacement.Text = "\1\2\3" .Replacement.Font.Italic = True .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = True .Execute Replace:=wdReplaceAll End With

' Traiter _texte_ (mais pas __texte__)
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([^_])_([!_]@)_([^_])"
    .Replacement.Text = "\1\2\3"
    .Replacement.Font.Italic = True
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

End Sub

Sub TraiterCodeInline() ' Traiter code With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "([!]@)`" .Replacement.Text = "\1" .Replacement.Font.Name = "Courier New" .Replacement.Font.Size = 10 .Replacement.Shading.BackgroundPatternColor = RGB(240, 240, 240) .Forward = True .Wrap = wdFindContinue .Format = True .MatchWildcards = True .Execute Replace:=wdReplaceAll End With End Sub

Sub TraiterListesPuces() Dim para As Paragraph

For Each para In ActiveDocument.Paragraphs
    If Left(Trim(para.Range.Text), 2) = "- " Or Left(Trim(para.Range.Text), 2) = "* " Then
        para.Range.Text = Mid(Trim(para.Range.Text), 3) & vbCr
        para.Range.ListFormat.ApplyBulletDefault
    End If
Next para

End Sub

Sub TraiterListesNumerotees() Dim para As Paragraph Dim regex As Object Set regex = CreateObject("VBScript.RegExp")

regex.Pattern = "^\d+\.\s"
regex.Global = True

For Each para In ActiveDocument.Paragraphs
    If regex.Test(Trim(para.Range.Text)) Then
        para.Range.Text = regex.Replace(Trim(para.Range.Text), "") & vbCr
        para.Range.ListFormat.ApplyNumberDefault
    End If
Next para

End Sub

Sub TraiterLiens() ' Traiter texte With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[([!]]@)](([!)]@))" .Replacement.Text = "\1" .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True

    Do While .Execute
        ' Créer un hyperlien
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
            Address:=Selection.Range.Text, _
            TextToDisplay:=Selection.Range.Text
    Loop
End With

End Sub

Sub TraiterBlocsCode() Dim startPos As Long, endPos As Long Dim codeRange As Range

' Rechercher les blocs de code ```
With Selection.Find
    .ClearFormatting
    .Text = "```*```"
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    
    Do While .Execute
        Set codeRange = Selection.Range
        ' Supprimer les balises ```
        codeRange.Text = Mid(codeRange.Text, 4, Len(codeRange.Text) - 6)
        ' Appliquer le formatage de code
        With codeRange
            .Font.Name = "Courier New"
            .Font.Size = 9
            .Shading.BackgroundPatternColor = RGB(245, 245, 245)
            .Borders.Enable = True
            .ParagraphFormat.SpaceAfter = 6
            .ParagraphFormat.SpaceBefore = 6
        End With
    Loop
End With

End Sub

patlegu/markdown-to-word-macro.md