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