Const Img_temp As String = "Monrépertoire\sens_interdit.jpg"
Sub Envoi_Documents()
'Utilise la liaison anticipée
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
Dim Document As Range
Dim Objet_Mail As String
Dim Adresse_Mail As String
Sheets("Mail").Visible = True
Sheets("Mail").Select
Application.ScreenUpdating = True
'Quadrillage
ActiveWindow.DisplayGridlines = False
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
'Parcourt en boucle les lignes
For Each Document In Sheets("Mail").Range("pièces")
[corps_message_1] = Document.Offset(0, 3)
[corps_message_2] = Document.Offset(0, 4)
'Obtenir les données
Objet_Mail = Document.Offset(0, -1)
Adresse_Mail = Document.Offset(0, -3)
'Créer l'élément de mail et le transmettre
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
With MonItem
.To = Adresse_Mail
.Subject = Objet_Mail
If Not IsEmpty(Document.Offset(0, -2)) Then .CC = Document.Offset(0, -2)
.Categories = "Daily"
.Attachments.Add Document
For I = 1 To 2
If Not IsEmpty(Document.Offset(0, I)) Then
Fichier_joint = "Monrépertoire\" & Document.Offset(0, I).Value
.Attachments.Add Fichier_joint
End If
Next
If Not IsEmpty(Adresse_Mail_CC) Then _
.CC = Adresse_Mail_CC
.Display
End With
'copie du corps de texte dans le corps de message
Call Plage_Mail
Application.Wait (Now + TimeValue("0:00:01"))
AppActivate Objet_Mail & " - Message", 0 ' Active Outlook
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "^v", True ' coller
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys "%v", True ' Envoi du message
Application.CutCopyMode = False
Next
Set Applic_Outlook = Nothing
ActiveWindow.DisplayGridlines = True
End Sub
Sub Plage_Mail()
Call Image_Temporaire
End Sub
Sub Image_Temporaire(Optional dummy As Byte)
Dim cellule_corp As Range
Dim image_chart As ChartObject
Set cellule_corp = Range("corps_1")
cellule_corp.CopyPicture xlScreen, xlBitmap
With cellule_corp
Set image_chart = ActiveSheet.ChartObjects.Add( _
.Left, .Top, .Width + 5, .Height + 5)
End With
With image_chart.Chart
.Paste
.Export Filename:=Img_temp
End With
image_chart.Delete
Set image_chart = Nothing
Set cellule_corp = Nothing
End Sub