Bonjour,

Je suis entrain de creer un mail Lotus automatique auquel je souhaite incorporer un tableau excel avec des combobox et textbox.
Pour me simplifier la vie, je suis partie sur la piste de coller une image dans le corps du mail, mais je ne trouve pas comment coller.

Voici mon processus actuel :
- Copie du tableau sous forme d'image : J'ai le code
- Creation d'un mail Lotus : J'ai le code pour afficher du text dans le body
- Collage de l'image dans le body : Je ne trouve pas de solution.

Est-ce que vous avez une idée ??

Voici mon code pour la copie du tableau sous forme d'image :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub imprimecran()
'  ActiveWorkbook.Worksheets("NomFeuille").Activate
'on mémorise si le quadrillage est affiché
  DG = ActiveWindow.DisplayGridlines
'on enlève le quadrillage
  ActiveWindow.DisplayGridlines = False
 
Tableau = ActiveSheet.PageSetup.PrintArea
'Copie, en tant qu'image, les cellules sélectionnées dans la feuille.
  Range(Tableau).CopyPicture
 
'on colle
  ActiveSheet.Paste
'on recopie dans le presse papier
  Selection.Copy
'on supprime l'image temporaire
  Selection.Delete
'on rétablie le quadrillage comme à l'origine
  ActiveWindow.DisplayGridlines = DG

End Sub
Et voici le code pour générer et envoyer le mail - Par contre, pour le moment j'ai du texte brut dans le body et pas mon tableau !
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .
'entrée du CheminEtFichier s'il y a lieu
'entrée Sujet et Message As String

Sub UseLotus() '(CheminEtFichier As String, Sujet As String, Message As String)
    Dim oSession As Object     'CreateObject("Notes.NotesSession")
    Dim UserName As String     'Nom d'utilisateur
    Dim DataBase As Object     'Base des mails
    Dim DataBaseName As String 'Nom de la base
    Dim Document As Object     'Mail
    Dim AttachME As Object     'Fich joint en RTF
    Dim AttachF1 As Object     '1' pièce attachée
    Dim i, j, txtbody, CheminEtFichier, Msg$, T$


    
    On Error GoTo ErreurNET: Err.Clear '*****
    

    
    
    ' Crée la session
    Set oSession = CreateObject("Notes.NotesSession")
    Set Workspace = CreateObject("Notes.NotesUIWorkspace") '''''
    ' Récupère nom d'utilisateur
    UserName = oSession.UserName
    DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    ' Ouvre la base des mails (si fermé, ouvre et demande le password)
    Set DataBase = oSession.GETDATABASE("", DataBaseName)
    If Not DataBase.IsOpen Then DataBase.OPENMAIL
    
    '########################## envoi ###############################################
    'récupère dans la feuille nommée NomDeLaFeuilDATA$ et le Range nommé "CellDATA_AdresDestinataire"
    'les adresses séparées par ";"
    Dim Tablo As Variant, AdresDestinataire As String
    ' AdresDestinataire = Sheets("data").Range("b5")
    AdresDestinataire = "toto@toto.com"
    If InStr(AdresDestinataire, ";") = 0 Then AdresDestinataire = AdresDestinataire & ";"
    Tablo = Split(AdresDestinataire, ";")
    '       boucle envoi                 .
    For i = LBound(Tablo) To UBound(Tablo)
     If Trim(Tablo(i)) > "" Then
        AdresDestinataire = Tablo(i)
        
        'crée le document et colle /AdresDestinataire /Sujet /Message
        Set Document = DataBase.CREATEDOCUMENT
        
        Document.Form = "Memo"
        Document.SendTo = AdresDestinataire
        Document.Subject = AC_New_Number & " - Une nouvelle action a été crée par " & Sheets("Description").TextBox1
        
        'définition du corps du message
        'For j = 1 To 10
            txtbody = txtbody & Range("D" & j + 4) & vbLf
            txtbody = "Problème : " & Sheets("Description").TextBox6 & vbLf
            txtbody = txtbody & "Cause potentielle : " & Sheets("Description").TextBox5 & vbLf
            txtbody = txtbody & vbLf & vbLf & vbLf & "E-mail généré automatiquement par la base Amélioration Continue"
        'Next j
        Document.Body = txtbody


        
        
        'Joint le Fichier s'il y en a un !?
        If CheminEtFichier <> "" Then
           Set AttachME = Document.CREATERICHTEXTITEM("Attachment")
           Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
        End If
        
        'Envoi le Mail
        Document.SAVEMESSAGEONSEND = False 'True svg dans les courriers envoyés
        Document.PostedDate = Now()
        Document.send 0, AdresDestinataire
        ' suite...
        Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
     End If
    Next
    GoTo FinMail ' fin ##############################################################
    
ErreurNET:
    Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
    T$ = "Envoi Mail: Problème de connexion !?"
    MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
    GoTo FinMail
    
FinMail:
    Set oSession = Nothing: Set DataBase = Nothing
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
    On Error GoTo 0: Err.Clear
End Sub