Mise en forme de mes cellules Excel

bonsoir

je n'arrive pas a garder la mise en forme de mes cellules excel

vous trouverez mon code ainsi que mon fichier

merci de vos réponses

12classeur1.xlsm (24.50 Ko)
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")
        .Body = ""
        .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
        OutMail.Body = OutMail.Body & vbCrLf & texte
    Else
        MsgBox "Vous devez d'abord ouvrir Outlook en appuyant sur le bouton 'Ouvrir Outlook'.", vbExclamation
    End If
End Sub

bonjour,

pour garder une mise en forme excel dans un mail, il faut convertir la mise en forme excel en HTML et utiliser la propriété .HtmlBody de MailItem

a quel endroit dois je mettre ça?

rebonjour,

utilise .htmlbody partout où tu vois .body.

Mais tu dois convertir le format excel en format HTML. par exemple pour mettre un texte en gras utilise les balise <B></B>

<B>texte en gras</B>

quelques balises HTML ici

Ne marchant toujours pas j'ai mis cette soultion en place par contre

ce que je voudrais c'est faire apparaitre ma signature de mon mail outlook directement

Merci de vos réponses

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")
        .HTMLBody = "" & .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

en mettant ce code ma signature ne s'affiche pas

par contre quand je mets .Display avec with outMail

celle ci s'affiche mais par contre impossible de rajouter mon texte grace a mes boutons

je suis en train de perdre mon latin

si quelqu'un peut m'aider

Rechercher des sujets similaires à "mise forme mes"