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
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 Subbonjour,
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 Suben 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