Skip to content

Instantly share code, notes, and snippets.

@patlegu

patlegu/markdown-to-word-macro.md

Last active September 23, 2025 14:37
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save patlegu/56522fa2efcdc53ec832861b906a6f35 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save patlegu/56522fa2efcdc53ec832861b906a6f35 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. patlegu revised this gist Sep 23, 2025. No changes.
  2. patlegu revised this gist Sep 23, 2025. 1 changed file with 246 additions and 1 deletion.
    247 changes: 246 additions & 1 deletion markdown-to-word-macro.md
    View file
    Original file line number Diff line number Diff line change
    @@ -1 +1,246 @@
    ⁤
    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](url)
    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
  3. patlegu created this gist Sep 23, 2025.
    1 change: 1 addition & 0 deletions markdown-to-word-macro.md
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1 @@
    ⁤