lepigoennier
XLDnaute Junior
Bonjour,
Je dois envoyer en fichier attaché un document excel soit en français soit en anglais. L'utilisateur doit cocher s'il veut l'envoyer en français ou en anglais. Lorsque j'exécute ma macro, tout se fait bien sauf le corp du message. Il semble y avoir un bug au niveau de ma condition pour le coprs du courriel. Est-ce que quelqu'un peut éclairer ma lanterne svp?
Merci
Voici mon code :
Je dois envoyer en fichier attaché un document excel soit en français soit en anglais. L'utilisateur doit cocher s'il veut l'envoyer en français ou en anglais. Lorsque j'exécute ma macro, tout se fait bien sauf le corp du message. Il semble y avoir un bug au niveau de ma condition pour le coprs du courriel. Est-ce que quelqu'un peut éclairer ma lanterne svp?
Merci
Voici mon code :
Code:
Sub Mail_workbook_Outlook_1()
Dim OutApp As Object
Dim OutMail As Object
Dim adresse As String
Dim message As String
Dim sujet As String
Dim LeNom As String
Dim messageanglais As String
Dim messagefrancais As String
Sheets("Fournisseur").Visible = True
' ------------------------------ Feuille si BAA demandé
Sheets("Acheteur").Select
If Range("C30").Value = 1 Then
Sheets("BAA").Visible = True
Else
Sheets("BAA").Visible = False
End If
Sheets("Acheteur").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Fournisseur").Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
' ------------------------------ Protection du classeur et des feuilles
Worksheets("Fournisseur").Protect Password:="achat", DrawingObjects:=True
ActiveWorkbook.Protect Password:="achat", Structure:=True, Windows:=False
LeNom = Range("A9")
ActiveWorkbook.SaveAs LeNom
adresse = Range("C2")
partnumber = Range("A9")
messageanglais = "Good day, ..."
messagefrancais = "Bonjour, ..."
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
ThisWorkbook.Save
' ------------------------------ envoi du message français
If Range("D28").Value = 1 Then
On Error Resume Next
With OutMail
.To = adresse
.CC = ""
.BCC = ""
.Subject = partnumber
.Body = messsagefrancais
.Attachments.Add ActiveWorkbook.FullName
.Attachments.Add ("c:\Conditions1.pdf")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
On Error Resume Next
' --------------------------- envoi du message anglais
Else
On Error Resume Next
With OutMail
.To = adresse
.CC = ""
.BCC = ""
.Subject = partnumber
.Body = messsageanglais
.Attachments.Add ActiveWorkbook.FullName
.Attachments.Add ("c:\Conditions1.pdf")
.Display
End With
On Error GoTo 0
End If
Set OutMail = Nothing
Set OutApp = Nothing
End Sub