Discussion :

[goninph]

Bonjour,

J'ai une erreur intermittente sur cette ligne : Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

J'ai essayé de faire une pause, à voir dans le temps ...

Si vous avez une solution je suis preneur

Meilleures salutations

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
Private Sub BT_Mail_Facturation_Click()
ThisWorkbook.Activate 'Évite que la macro ne se lance sur un autre fichier ouvert
Dim Messagerie As Object
Dim Email As Object
Dim Objet As Variant
Dim Message As Variant
Dim Derniere_Ligne As Long
Dim Tableau As ListObject
Dim Plage As Range
Dim Image As String
Dim Zone_Graphique As ChartObject
Dim f As Worksheet
    Set f = ThisWorkbook.Sheets("Facturation")
 
    If MsgBox("Envoyer un mail au contentieux ? ", vbYesNo + vbQuestion, "Facturation") = vbYes Then
 
        Backup.Ouvrir_Outlook
 
        'Objet du mail
        Objet = "Fichier de facturation mise à jour des sommes reçues - " & f.Range("Cell_Facturation_Cmde") & " - " & f.Range("Cell_Facturation_Adresse")
 
        'Message du mail
        Message = "Bonjour,<br><br>" & _
                  "Avons-nous reçu les paiements ? Voir colonne Etat<br><br>" & _
                  "Meilleures salutations<br>" & _
                  Application.UserName
 
        'Créer une image du tableau
        Set Tableau = f.ListObjects("TS_Facturation")
        If Application.WorksheetFunction.CountA(Tableau.ListColumns("Cmde").DataBodyRange) <> 0 Then
            With Tableau.ListColumns("Cmde").DataBodyRange
                Derniere_Ligne = f.ListObjects("TS_Facturation").Range.Rows(f.ListObjects("TS_Facturation").Range.Rows.Count).Row
            End With
        Else
            Derniere_Ligne = 11
        End If
 
        'Création de l'image
        Application.ScreenUpdating = True 'Forcer à true sinon l'image sera blanche
        Set Plage = f.Range(f.Cells(2, Tableau.ListColumns("Offre").Range.Column), f.Cells(Derniere_Ligne, Tableau.ListColumns("Descriptif").Range.Column))
        Application.Wait Now + TimeValue("00:00:02")
        Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        Image = "C:\temp\Image.jpg"
        Set Zone_Graphique = f.ChartObjects.Add(0, 0, Selection.Width, Selection.Height)
        With Zone_Graphique
            .Activate
            .Height = Plage.Height
            .Width = Plage.Width
            .Chart.Paste
            .Chart.Export Image, "JPG"
            .Delete
        End With
 
        'Création du mail avec Outlook
        Set Messagerie = CreateObject("Outlook.Application")
        Set Email = Messagerie.CreateItem(0)
        With Email
            .To = "contentieux@zurbuchensa.ch"
            .CC = ""
            .Subject = Objet
            .HTMLBody = "<span style='font-family: Calibri Light; font-size: 11pt;'>" & Message & "<br><br></span>" & _
            "<img src='" & Image & "' alt='Image'>"
            .Display
        End With
 
        'Supprimer l'image temporaire
        Kill Image
 
        Messagerie.ActiveWindow.WindowState = 0 '0=Maximized, 1=Minimized, 2=Normal
 
        Set Email = Nothing
        Set Messagerie = Nothing
        Set Tableau = Nothing
        Set Plage = Nothing
        Set Zone_Graphique = Nothing
 
    End If
End Sub

[patmeziere]

Bonjour goninph
1°
il faudra nous expliquer pourquoi tu va chercher l'index de dernière ligne dans un tableaux structuré alors que le data body est sensé te le donner la plage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Plage = f.Range(f.Cells(2, Tableau.ListColumns("Offre").Range.Column), f.Cells(Derniere_Ligne, Tableau.ListColumns("Descriptif").Range.Column))

2°
il faudra nous expliquer aussi pourquoi une pause de 2 secondes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    Application.Wait Now + TimeValue("00:00:02")
 
  Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        Image = "C:\temp\Image.jpg"

3° nous expliquer aussi pourquoi redimensionner dans le bloc with alors qu'il est créé selon la dimension de la plage ;d'ailleurs dans le code a aucun moment tu fait une selection de la dite "Plage" donc selection c'est la plage de cellule sélectionnée actuellement ce qui n'est peut être pas la plage voulue

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Set Zone_Graphique = f.ChartObjects.Add(0, 0, Selection.Width, Selection.Height)
        With Zone_Graphique
            .Activate
            .Height = Plage.Height
            .Width = Plage.Width

4° il faudrait aussi nous expliquer pourquoi là ou il le faudrait (surtout sur les versions d'excel récentes)il n'y a pas de gestion d'attente pour que le paste puisse coller un bitmap dans le chart

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
.Chart.Paste
            .Chart.Export Image, "JPG"
            .Delete
        End With

5°il faudra aussi nous expliquer ce que tu espère dans le code html au niveau du SRC de la balise image
car jusqu’à preuve du contraire la variable image contient le path du fichier dans ton disque dur hors!! le src doit faire référence a une pièce joindre pour être afficher dans le corps du mail autrement dit uniquement le nom avec son extension

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 "<img src='" & Image & "' alt='Image'>"

d'ailleurs a aucun moment dans le code tu envoie l'image dans le serveur utilisé dans ta session outlook ( à moins que mes yeux me jouent des tours )

bref c'est assez brouillon tout ça difficile d'y faire le ménage même si on comprend à peu près l'intention

[goninph]

Merci de m'avoir répondu

1. Je définis la plage entre 2 colonnes et que les lignes filtrées

2. C'est justement le problème de ce code qui fonctionne nickel, mais qui plante une fois deux sans la pause et une fois sur dix avec cette pause

3. Sinon l'image est toute petite, aux dimensions d'une cellule

4. L'attente du point 2 devrait être placée ici ?

5. Aucune idée, je sais que l'image est collée à la bonne place dans le mail, mais c'est volontier que je prends une explication ou les corrections nécessaire à apporter

A toute

Le résultat est selon la copie d'écran ci-dessous

Un mail avec une image du tableau collée en dessous

[patmeziere]

re
que donne simplement l'address du databodyrange de ton tableau structuré filtré dans un msgbox
on pourrait avoir cette feuille avec des données bidons pour tester
mais déjà si tu test le msgbox ça devrait t'éclairer un peu

[patmeziere]

re
je viens de tester car tu m'a mis le doute
filtré ou pas la capture se fait avec ce qu'il y a de visible
pas besoins de déterminer quoi que ce soit avec un listobject(tableau structuré)
test en filtrant ton tableau

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub test()
 'filtré ou pas le tableau sera capturé
 'il n'y aura pas les lignes non visible c'est tout
 Set plage = ActiveSheet.ListObjects("Tableau1").DataBodyRange'adapte le nom de ton TS 
 plage.CopyPicture
ActiveSheet.Paste
 
End Sub

[goninph]

Le problème principal est la création de l'image qui beug une fois sur cinq sur cette ligne Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Pour la plage je ne veux pas tout le tableau, juste la plage de d'une colonne à une autre des lignes visibles

[patmeziere]

donne un fichier avec le tableau et on verra ce que l'on peut faire

[goninph]

donne un fichier avec le tableau et on verra ce que l'on peut faire

Impossible données confidentielles

[patmeziere]

punaise tu sais pas bidonner quelques cellules
faire un copier et coller valeur pour supprimer toute formule
ca prend 2 sec

bon courage

[goninph]

Sur mon PC personnel, ce code ne plante plus

À voir demain au job

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
Private Sub BT_Mail_Facturation_Click()
ThisWorkbook.Activate ' Évite que la macro ne se lance sur un autre fichier ouvert
Dim Messagerie As Object
Dim Email As Object
Dim Objet As String
Dim Message As String
Dim Derniere_Ligne As Long
Dim Tableau As ListObject
Dim Plage As Range
Dim Image As String
Dim f As Worksheet
 
    Set f = ThisWorkbook.Sheets("Facturation")
 
    If MsgBox("Envoyer un mail au contentieux ? ", vbYesNo + vbQuestion, "Facturation") = vbYes Then
 
        'Ouvrir Outlook si nécessaire
        Backup.Ouvrir_Outlook
 
        'Objet du mail
        Objet = "Fichier de facturation mise à jour des sommes reçues - " & f.Range("Cell_Facturation_Cmde").value & " - " & f.Range("Cell_Facturation_Adresse").value
 
        'Message du mail
        Message = "Bonjour,<br><br>" & _
                  "Avons-nous reçu les paiements ? Voir colonne Etat<br><br>" & _
                  "Meilleures salutations<br>" & _
                  Application.UserName
 
        'Créer une image du tableau
        Application.ScreenUpdating = True ' Forcer à true sinon l'image sera blanche
        Set Tableau = f.ListObjects("TS_Facturation")
        If Application.WorksheetFunction.CountA(Tableau.ListColumns("Cmde").DataBodyRange) <> 0 Then
            Derniere_Ligne = Tableau.Range.Rows(Tableau.ListRows.Count).Row
        Else
            Derniere_Ligne = 11
        End If
 
        'Création de l'image
        Application.ScreenUpdating = True 'Forcer à true sinon l'image sera blanche
        Set Plage = f.Range(f.Cells(2, Tableau.ListColumns("Offre").Range.Column), f.Cells(Derniere_Ligne, Tableau.ListColumns("Descriptif").Range.Column))
        Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
 
        Image = Environ("TEMP") & "\Image.jpg"
        With f.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Image, "JPG"
            .Delete
        End With
 
        ' Création du mail avec Outlook
        Set Messagerie = CreateObject("Outlook.Application")
        Set Email = Messagerie.CreateItem(0)
        With Email
            .To = "contentieux@zurbuchensa.ch"
            .CC = ""
            .Subject = Objet
            .HTMLBody = "<span style='font-family: Calibri Light; font-size: 11pt;'>" & Message & "<br><br></span>" & _
                        "<img src='" & Image & "' alt='Image'>"
            .Display
        End With
 
        ' Supprimer l'image temporaire
        If Dir(Image) <> "" Then Kill Image
 
        Messagerie.ActiveWindow.WindowState = 0 ' 0=Maximized, 1=Minimized, 2=Normal
 
    End If
 
    Set Email = Nothing
    Set Messagerie = Nothing
    Set Tableau = Nothing
    Set Plage = Nothing
End Sub

[goninph]

Bonjour,

Comme demandé le fichier est en pièce jointe

Merci pour votre aide

'!!!!!!!!!!!!!!!!!! Plante un fois sur 2 sur la ligne suivante !!!!!!!!!!!!!!!!!!
Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Image dans mail.xlsm

[Nain porte koi]

Sur mon PC personnel, ce code ne plante plus

Ca ne plante pas non plus sur le mien, donc c'est peut-être sur le PC du boulot qu'il y a qqchose qui pose problème, non ? ...surtout si ça n'est pas à chaque fois !

[patmeziere]

Bonjour bonjour

de toute facon quand je vois des trucs du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Image = Environ("TEMP") & "\Image.jpg"

et que plus bas je vois

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.HTMLBody = "<span style='font-family: Calibri Light; font-size: 11pt;'>" & Message & "<br><br></span>" & _
                        "<img src='" & Image & "' alt='Image'>"

alors qu'il n'y a même pas de AddAttachment dans le mail

il va la recevoir la capture le destinataire c'est sur

vous êtes sérieux là ?

gonimph a tu un plan B? je sais pas moi ;des pigeons , un coursier , beep beep

si oui prends le plan B

je prends le temps de t'expliquer

l'image tu la vois par ce que tu es sur ton pc donc le lien est bon
mais quand le mail sera ouvert dans l'application mail de ton destinataire lui n'a pas de lien vers ton pc (et heureusement d'ailleurs)
conclusion il aura un petit carré vide avec une petite crois indiquant que l'image est indisponible

[goninph]

Ok et merci pour les explications

Comment créer ce type de mail avec une image collée au bas de celui-ci ?

[patmeziere]

Allez je prends le temps
regarde bien la video

et pour finir si je dois mettre au propre l'intention

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
Option Explicit
Sub Mail_Facturation()
    ThisWorkbook.Activate ' Évite que la macro ne se lance sur un autre fichier ouvert
    Dim Messagerie As Object, Email As Object, Objet$, Message$, Plage As Range, Image$, f As Worksheet
 
    Set f = ThisWorkbook.Sheets("Facturation")
 
    If MsgBox("Envoyer un mail au contentieux ? ", vbYesNo + vbQuestion, "Facturation") = vbYes Then
 
        Image = Environ("TEMP") & "\Image.jpg"
        '-------------------------------------------------------------------------------------
        'Message du mail
        Message = "<span style='font-family: Calibri Light; font-size: 11pt;'>" & _
                   "Bonjour,<br><br>" & _
                   "Avons-nous reçu les paiements ? Voir colonne Etat<br><br>" & _
                   "Meilleures salutations<br>" & _
                   Application.UserName & "<br><br></span>" & _
                   "<img src='" & Mid(Image, InStrRev(Image, "\") + 1) & "' alt='Image'>"
        '-------------------------------------------------------------------------------------
 
        Application.ScreenUpdating = True ' Forcer à true sinon l'image sera blanche
        '-------------------------------------------------------------------------------------
 
        'le tableau a copier
        Set Plage = Range("TS_Facturation[[#headers],[#data],[Année]:[Descriptif]]")
 
        If WorksheetFunction.CountA(Plage.Columns(1)) > 2 Then
            Set Plage = Plage.Resize(Plage.Rows.Count + Plage.Row - 2).Offset(-Plage.Row + 2)
        Else 'si il n'y a pas de dats dans le TS
            Set Plage = f.[a2].Resize(Plage.Row - 2, Plage.Columns.Count)
        End If
        '-------------------------------------------------------------------------------------
 
        Plage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        '-------------------------------------------------------------------------------------
        'Object chart pour export de la capture
        With f.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
            .Activate
            Do While .Chart.Pictures.Count = 0: .Chart.Paste: Loop
            .Chart.Export Image, "JPG"
            .Delete
        End With
        '-------------------------------------------------------------------------------------
 
        'Object Mail Outlook
        'Objet du mail
        Objet = "Fichier de facturation mise à jour des sommes reçues - " & CStr(f.Range("Cell_Facturation_Cmde").Text) & " - " & CStr(f.Range("Cell_Facturation_Adresse").Text)
        ' Création session Outlook
        Set Messagerie = CreateObject("Outlook.Application")
        Set Email = Messagerie.CreateItem(0)
        With Email
            .To = "contentieux@zurbuchensa.ch"
            .CC = ""
            .Subject = Objet
            .Attachments.Add Image ' une premiere fois pour qu'il soit dipo sur le serveur du mail
            .Attachments.Add Image ' une 2d fois si on veux qu'elle soit en piece jointe aussi
            .HTMLBody = Message
            .Display
        End With
        '-------------------------------------------------------------------------------------
 
        ' Supprimer l'image temporaire
        If Dir(Image) <> "" Then Kill Image
 
        Messagerie.ActiveWindow.WindowState = 0 ' 0=Maximized, 1=Minimized, 2=Normal
    End If
 
    Set Email = Nothing
    Set Messagerie = Nothing
    Set Plage = Nothing
End Sub

voila là ton mail va partir avec l'image

[rMist2024]

Regarde de côté Embedded Image où l' image est transformée au format base64 puis insérée dans le texte de la page html

[patmeziere]

Bonjour Rmist2024
je connais tres bien le principe
je tourne sur 2013 et 2016 en 32 bits
et il n'y a pas le code en base64 de l'image dans le SRC

peut être est ce une nouvelle fonction sur des versions plus recentes
en tout cas chez moi j'ai le lien ou le nom du fichier

avec ma version

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

<span style='font-family: Calibri Light; font-size: 11pt;'>Bonjour,<br><br>Avons-nous reçu les paiements ? Voir colonne Etat<br><br>Meilleures salutations<br>patricktoulon<br><br></span><img src='Image.jpg' alt='Image'>

avec image string complet du chemin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

<span style='font-family: Calibri Light; font-size: 11pt;'>Bonjour,<br><br>Avons-nous reçu les paiements ? Voir colonne Etat<br><br>Meilleures salutations<br>patricktoulon<br><br></span><img src='C:\Users\PATRIC~1\AppData\Local\Temp\Image.jpg' alt='Image'>

cela dit j'ai la fonction pour ça si tu veux tu devrait la trouver ici sur dvp elle date un peu

sauf que par exemple sur outlook 2013 le code "je ne sais quoi" dans un embed n'est pas tout a fait du base 64 microsoft a son propre code style base 64

je le sais car quand je teste sur 2007 mon convertisseur base64 fonctionne dans le src des imag dans outlook
mais sur 2013 non et 2016 non plus

[patmeziere]

re
je viens d'avoir confirmation
outlook n'encode pas automatiquement en b64
il est possible cependant que le récepteur selon son app mail
que son app mail reconstruise le mime avec l'image encodée en b64
ca veux dire que pour cela l'image ben ..... il faut quelle parte
si il n'y a pas de de attachments.add +(facultativement le paramétrage du cid pour le src l'image ne partira pas
je crois me souvenir qu'avec outlook 2003(c'est loin) on pouvait accéder au content mime et récupérer le code b64 de l'image
mais sur 2007 ça fonctionnait déjà plus

donc mon code proposé après la video est parfaitement fonctionnel

[rMist2024]

En fait, j'avais fait quelques tests et ca a fonctionné pour afficher les images dans le navigateur mais il semble que ce soit impossible dans Outlook comme la majorité des applications de messagerie bloquent ces images même qu elles restent présentes dans la page.

[patmeziere]

re
d’où la solution que je propose qui est plus sur
le SRC fait référence à l'image dans le dossier du mail lui même sur le serveur de la messagerie
avec ça au moins on a la garantie que l'image est emportée