Envoi Fichier Excel par mail sous lotus avec spécifitées

Bonjour

Je suis un peu rouillé en vba et j'ai besoin de votre aide s'il vous plait,

Je dois créer une macro excel pour envoyer un mail via lotus Note.

(sous excel 2010)

Cette macro doit à partir du fichier Classeur2.xlsx ci joint:

1. Inscrire les destinataires dans le mail en fonction des cellules H5 et H6.

2. Inscrire le titre du mail en fonction des cellules F5 et H4.

3. Copier dans le corps du mail une image des cellules B1 à H157

4. Enregistrer le fichier en pdf - nom défini en fonction des celulles H5et H4

5. Envoyer ledit fichier renommé dans le corps du mail en PJ

6. Envoyer 2 autres fichiers présents dans un autre répertoire dans le corps du mail en pj

J'ai récupéré 2 macros qui font la quasi totalité du taf (sauf fonction 4 et 5) et que je tente de compiler l'une avec l'autre mais pas moyen d'y arriver.

Je suis conscient que ma demande est complexe aussi merci par avance pour votre aide.

Ma 1ère macro est celle ci:

Sub Macro_n°1()

'Elle fait la fonction 2 et 3

Dim Notes As Object, db As Object, Workspace As Object

Dim Maildb As Object

Dim UserName As String

Dim MailDbName As String

Dim MailDoc As Object

Dim AttachME As Object

Dim Session As Object

Dim EmbedObj As Object

jour = " du " & Date

Set Notes = CreateObject("Notes.NotesSession")

UserName = Notes.UserName

MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

Set db = Notes.GetDataBase(vbNullString, MailDbName)

Set Workspace = CreateObject("Notes.NotesUIWorkspace")

Call Workspace.ComposeDocument(, , "Memo")

Set UIdoc = Workspace.CurrentDocument

Call UIdoc.FieldSetText("SendTo", "xxx@hotmail.fr" & Range("L1").Value)

'2 - Insertion données dans titre du mail

Call UIdoc.FieldSetText("Subject", " Proposition de transport du " & Range("F4").Value & " " & Range("H5").Value)

'3- Insertion image du devis dans corps du mail

Worksheets("Feuil1").Range("B1:H157").CopyPicture

Call UIdoc.GotoField("Body")

Call UIdoc.Paste

Application.CutCopyMode = False

End Sub

et la 2nd macro

Sub Macro_n°2()

' Fais la fonction 1 - 5 - 6

'Fonction 1 et 6

Dim Recipient(2) As Variant

'pour deux destinataires

Dim Attachment(2) As Variant

'pour 2 pièces jointes

'Dim attachment As String

Dim BodyText As String

Dim SaveIt As Boolean

Dim Subject As String

'Fonction 1

'dim SendNotesMail(subject As String, Attachments As String, BodyText As String, SaveIt As Boolean)

Recipient(0) = [E6].Value

Recipient(1) = [F6].Value

Dim Maildb As Object 'The mail database

Dim UserName As String 'The current users notes name

Dim MailDbName As String 'THe current users notes mail databasename

Dim MailDoc As Object 'The mail document itself

Dim AttachME As Object 'The attachment richtextfile object

Dim Session As Object 'The notes session

Dim EmbedObj As Object 'The embedded object (Attachment)

'Start a session to notes

Set Session = CreateObject("Notes.NotesSession")

'Get the sessions username and then calculate the mail file name

'You may or may not need this as for MailDBname with some systems you

'can pass an empty string

UserName = Session.UserName

MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"

'Open the mail database in notes

Set Maildb = Session.GetDataBase("", MailDbName)

If Maildb.IsOpen = True Then

'Already open for mail

Else

Maildb.OpenMail

End If

'Set up the new mail document

Set MailDoc = Maildb.CreateDocument

MailDoc.Form = "Memo"

MailDoc.sendto = Recipient 'Envoi à tous les destinataires

MailDoc.Subject = Subject

MailDoc.Body = BodyText

MailDoc.ReturnReceipt = "1"

MailDoc.SaveMessageOnSend = SaveIt

'Fonction 6

'Set up the embedded object and attachment and attach it

Attachment(0) = "C:\Documents\Fichier 1.pdf"

'txtFromEmailAddress

Attachment(1) = "C:\Documents\Fichier 2.pdf"

'txtFromEmailAddress

'Les trois attachement sont les nom et chemins des fichiers à envoyer

For i = 0 To 1

If Attachment(i) <> "" Then

Set AttachME = MailDoc.CreateRichTextItem("Attachment(" & i & " )")

Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment(i), "Attachment(" & i & " )")

'mailDoc.CREATERICHTEXTITEM ("Attachment(" & i & " )" )

End If

Next i

'Send the document

MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder

MailDoc.SEND 0, Recipient

End Sub

Merci encore pour votre aide le fichier est en PJ.

Cordialement,