Discussion :

[NJdu68]

Bonjour à tous,

Je n'ai pas réussi à trouver ma solution sur le net ou sur le forum (peut être que j'ai mal chercher et je m'en excuse)

Je me suis inspirer de ce sujet pour ouvrir outlook et la fenetre d'envoi d'un email avec l'ajout d'un tableau copier/coller :
https://forum.excel-pratique.com/vie...98059&start=10

Je bloque sur 3 points :
1. Le fait de coller le tableau efface complètement le contenu du mail si une signature est déjà présente lors de la création d'un nouveau mail. Je souhaiterais que le tableau soit collé avant la signature ou alors que la signature soit rechargé après le collage du tableau
2. J'ai le message d'alerte "microsoft outlook : un programme essaie d'accéder........... autoriser l'accès pour 1 minute........". Je souhaiterais autoriser par défaut puis de remettre la sécurité en place a la fermeture/fin de la macro.
3. Je souhaiterais également modifier l'adresse mail expéditeur du mail et que ce ne soit pas celle pas défaut.

Auriez vous une solution à me proposer ? Je vous remercie pour votre aide

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
SUB TEST
Dim OL As Object, myItem As Object, wDoc As Object, rng As Object
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
 
   Sheets("ZOLL_AVIS").Activate
 
   Dim TOUR As String, TOURLIG As String, IMMAT As String, PASSAGEDOUANE As String, DERLIG As Byte
   TOURLIG = Sheets("ZOLL_AVIS").Range("B1").Row
   TOUR = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Value
   IMMAT = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Offset(1, 0).Value
   PASSAGEDOUANE = Sheets("ZOLL_AVIS").Range("B" & TOURLIG).Offset(2, 1).Value
   DERLIG = Sheets("ZOLL_AVIS").Range("A" & TOURLIG).End(xlDown).Row
 
    ' On prépare le mail en rentrant les paramètres : adresse des destinataires, en copie, objet du mail, contenu du mail
 
If MsgBox("OUI/YA = Senden der Mitteilung an D610" & Chr(13) & "NON/NEIN = Senden der Mitteilung an D605", vbYesNo, "ZOLL AVIS") = vbYes Then
    With myItem
            If Sheets("EMAIL").Range("B1").End(xlDown).Row = 2 Then
            .To = Sheets("EMAIL").Range("B2").Text
            Else
            .To = Join(Application.Transpose(Sheets("EMAIL").Range("B2:B" & Sheets("EMAIL").Range("A1").End(xlDown).Row).Value), ";") '"xxx@domaine"
            End If
        '.CC = "yyy@domaine"
        .Subject = "ZOLL AVIS - TOUR " & TOUR & " - " & IMMAT & " - GRENZUBERGANG " & PASSAGEDOUANE
        .Display
 
        ' Tableau coller
        Sheets("ZOLL_AVIS").Range("A" & TOURLIG & ":G" & DERLIG).Copy
        Set rng = wDoc.Content
        rng.Paste
    End With
    Else
    With myItem
            If Sheets("EMAIL").Range("A1").End(xlDown).Row = 2 Then
            .To = Sheets("EMAIL").Range("A2").Text
            Else
            .To = Join(Application.Transpose(Sheets("EMAIL").Range("A2:A" & Sheets("EMAIL").Range("A1").End(xlDown).Row).Value), ";") '"xxx@domaine"
            End If
        '.CC = "yyy@domaine"
        .Subject = "ZOLL AVIS - TOUR " & TOUR & " - " & IMMAT & " - GRENZUBERGANG " & PASSAGEDOUANE
        .Display
 
        ' Premier tableau
        Sheets("ZOLL_AVIS").Range("A" & TOURLIG & ":G" & DERLIG).Copy
        Set rng = wDoc.Content
        rng.Paste
    End With
End If
 
    Set OL = Nothing
    Set myItem = Nothing
    Set wDoc = Nothing
END SUB

[TonyNiort79]

Bonjour,
pour le point n°1, je copierai la plage concernée en JPG et je l'intégrerai dans le mail,

Pas de tests effectués, à adapter

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
'Création tableau en JPG pour insértion dans le mail
Dim Plage As Range
Set Plage = Sheets("ZOLL_AVIS").Range("A" & TOURLIG & ":G" & DERLIG).Range
 
    Application.CutCopyMode = False
    Plage.CopyPicture
        Plage.Select
        With ActiveSheet.ChartObjects.Add(0, 0, _
                Selection.Width, Selection.Height).Chart
                .Paste
                .Export ThisWorkbook.Path & Application.PathSeparator & "NomFichier" & ".jpg", "JPG"
        End With
            ActiveSheet.ChartObjects.Delete
 
     'ajouter la ligne .Body après .Subject pour intégrer l'image dans le mail à la suite du texte
     'a adapter
    .Body = "<img src='C:\AdresseRepertoire\NomFichier.JPG'></img></html>"