[XL-2003] Ajouter un message à un mail

Bonsoir,

j'essaie d'ajouter un message au code VBA ci-dessous; comment faire ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Mail_sheets()
 
    Dim MyArr As Variant
    Dim last As Long
    Dim shname As Long
    Dim a As Integer
    Dim Arr() As String
    Dim N As Integer
    Dim strdate As String
    For a = 1 To 253 Step 3
        If ThisWorkbook.Sheets("Mail").Cells(1, a).Value = "" Then Exit Sub
        Application.ScreenUpdating = False
        last = ThisWorkbook.Sheets("Mail").Cells(Rows.Count, a).End(xlUp).Row
        N = 0
        For shname = 1 To last
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = ThisWorkbook.Sheets("Mail").Cells(shname, a).Value
        Next shname
        ThisWorkbook.Worksheets(Arr).Copy
        strdate = Format(Date, "dd-mm-yyyy") & " à " & Format(Time, "h-mm")
        ActiveWorkbook.SaveAs "Flash_Recouvrement" _
                            & " au " & strdate & ".xls"
        With ThisWorkbook.Sheets("Mail")
            MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp))
        End With
        On Error Resume Next
        ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("Mail").Cells(1, a + 2).Value
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
    Next a
End Sub

A noter que le titre du message figure sur la feuille 'Mail' cellule C1; le nom de la feuille du classeur à transmettre figure dans la cellule A1; enfin le ou les destinataire dans la colonne B.

Slts