Private Sub CommandButton2_Click()
Dim pdfName As String
Dim OutApp As Object, OutMail As Object
CommandButton1.Visible = False
CommandButton2.Visible = False
CommandButton3.Visible = False
Select Case MsgBox("Vous allez envoyer un e-mail" & Chr(10) & _
"Voulez-vous continuer ?", vbOKCancel + vbCritical, "ATTENTION")
Case vbOK
Application.ScreenUpdating = False '...............................
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.2)
.RightMargin = Application.InchesToPoints(0.2)
.TopMargin = Application.InchesToPoints(0.236)
.BottomMargin = Application.InchesToPoints(0.236)
.Orientation = xlPortrait
.CenterHorizontally = True
.CenterVertically = True
End With
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
With ActiveSheet.Shapes("Picture 1")
.Height = 270
.Width = 400
End With
pdfName = ActiveWorkbook.Path & "\" & "Rapport.pdf"
'Ne sert à pas grand chose sauf embrouiller le débuggage
'On Error GoTo errorHandler
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Envoi Mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "mlksing@live.fr" ' le destinataire
.Subject = "Bilan" ' l'objet du mail
.Attachments.Add ActiveWorkbook.Path & "\" & "Rapport.pdf"
'.Body = "Trouves ici le Bilan de cette affaire"
'.HTMLBody = "<html><p>Bilan Horaire pour cette Affaire:</p>" & Chr(13) & "<img src='" & fichier2 & "'</BODY></HTML>"
.HTMLBody = "<html><body><p>Bilan Horaire pour cette Affaire:</p>" & Chr(13) & "<img src='" & fichier2 & "'</body></html>"
.Display 'pour voir
End With
Application.DisplayAlerts = False
Kill pdfName
ActiveSheet.Delete
Application.DisplayAlerts = True
Sheets("Feuil1").Activate 'On reste sur la feuille1.....
Unload Me 'On sort de l'UserForm.....
'Inutile si pas d'autre instructions aprés
Exit Sub
'Ne sert à rien si pas de case aprés
' Case vbCancel
' Exit Sub
End Select
'Et du coup ne sert à rien non plus
'errorHandler:
' MsgBox Err.Description
End Sub
,
