XL 2019 Probleme codage

Dim EmailBody As String ' Variable globale pour stocker le corps de l'e-mail

Sub OuvrirOutlook()
    ' Créer une nouvelle instance d'Outlook
    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    ' Créer un nouvel e-mail
    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(0) ' 0 = E-mail

    ' Remplir les destinataires
    With OutMail
        .To = Range("A2")
        .Subject = Range("B2")
        
        ' Ajoutez le corps de l'e-mail ici
        .HTMLBody = "Bonjour, veuillez trouver ci-joint la proposition pour votre entreprise." & " " & .HTMLBody
        .Display
    End With
End Sub


Sub AjouterLigne1()
    If Not IsObject(CreateObject("Outlook.Application")) Then
        MsgBox "Ouvrez d'abord Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
        Exit Sub
    End If
    AjouterLigne "Feuil2", "A1"
End Sub

Sub AjouterLigne2()
    If Not IsObject(CreateObject("Outlook.Application")) Then
        MsgBox "Ouvrez d'abord Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
        Exit Sub
    End If
    AjouterLigne "Feuil2", "A2"
End Sub

Sub AjouterLigne3()
    If Not IsObject(CreateObject("Outlook.Application")) Then
        MsgBox "Ouvrez d'abord Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
        Exit Sub
    End If
    AjouterLigne "Feuil2", "A3"
End Sub
Sub AjouterLigne(nomFeuille As String, nomCellule As String)
    If Not IsObject(CreateObject("Outlook.Application")) Then
        MsgBox "Ouvrez d'abord Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
        Exit Sub
    End If

    ' Vérifie si Outlook est ouvert
    On Error Resume Next
    Dim OutApp As Object
    Set OutApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    
    ' Si Outlook est ouvert, ajoutez le texte de la cellule spécifiée au corps de l'e-mail en cours
    If Not OutApp Is Nothing Then
        Dim OutMail As Object
        Set OutMail = OutApp.ActiveInspector.CurrentItem
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets(nomFeuille)
        Dim texte As String
        texte = ws.Range(nomCellule).Value
        Dim htmlText As String
        Dim index As Integer
        Dim inBold As Boolean
        Dim inUnderline As Boolean

        inBold = False
        inUnderline = False
        htmlText = ""

        For index = 1 To Len(texte)
            Dim currentChar As String
            currentChar = Mid(texte, index, 1)

            If currentChar = "*" Then
                inBold = Not inBold
                If inBold Then
                    htmlText = htmlText & "<b>"
                Else
                    htmlText = htmlText & "</b>"
                End If
            ElseIf currentChar = "_" Then
                inUnderline = Not inUnderline
                If inUnderline Then
                    htmlText = htmlText & "<u>"
                Else
                    htmlText = htmlText & "</u>"
                End If
            ElseIf currentChar = vbLf Then
                ' Pour gérer les sauts de ligne dans Excel (utilisez Chr(10) si nécessaire)
                htmlText = htmlText & "<br>"
            Else
                htmlText = htmlText & currentChar
            End If
        Next index

        OutMail.HTMLBody = OutMail.HTMLBody & "<br>" & htmlText
    Else
        MsgBox "Vous devez d'abord ouvrir Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
    End If
End Sub

Private Sub CommandButton1_Click()
    If Not IsObject(CreateObject("Outlook.Application")) Then
        MsgBox "Ouvrez d'abord Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
        Exit Sub
    End If
    AjouterLigne "Feuil2", "A4"
End Sub