Hello!
J'ai un soucis avec un code macro que j ai un peu adapte a partir d'une creation de Ron de Bruin.
En gros, ca me permet de :
- convertir une palge definie de cellules excel,
- la convertir en jpg
- pour la coller dans el corps d'un email
- et mettre en PJ de cet email un onglet excel

Par contre, dans la plage de cellule, il y a un TCD et je ne sais pas si c est ca, mais en dans le jpg je me retrouve avec en fond/background un graphique qui gache tout et qui n'existe pas dans la plage originale.
Si j enleve ce TCD, plus ce probleme mais bon du coup je n ai plus la photo que je veux....

Merci d'avance

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
 Sub SendMail_SAT()
 
        Dim TempFilePath As String
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xHTMLBody As String
        Dim xRg As Range
 
       On Error Resume Next
        Set xRg = ThisWorkbook.Worksheets("Dashboard_SAT").Range("a1:J56")
        If xRg Is Nothing Then Exit Sub
        With Application
          .Calculation = xlManual
          .ScreenUpdating = False
          .EnableEvents = False
        End With
 
 
        Set xOutApp = CreateObject("outlook.application")
        Set xOutMail = xOutApp.CreateItem(olMailItem)
 
        Call createJpg_AT(ActiveSheet.Name, xRg.Address, "Dashboard_SATFile")
 
        TempFilePath = Environ$("temp") & "\"
        xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Bonjour, <br> " _
                & "<br>" _
                & "Vous trouverez ci dessous  au " & ThisWorkbook.Worksheets("Dashboard_SAT").Range("A4").Value & "." _
                & "<br>" _
                & "<img src='cid:Dashboard_SATFile.jpg'>" _
                & "<br>Bonne journee!" _
                & "<br>"
 
 
 
 
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set Sourcewb = ActiveWorkbook
 
    'Copy the ActiveSheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With
 
    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False
 
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Dashboard_SAT " & Format(Now, "dd-mmm-yy h-mm-ss")
 
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        With xOutMail
            .Subject = "DASHBOARD  -  " & ThisWorkbook.Worksheets("Dashboard_SAT").Range("A4").Value
            .HTMLBody = xHTMLBody
            .Attachments.Add Destwb.FullName
            .Attachments.Add TempFilePath & "Dashboard_SATFile.jpg", olByValue
            .To = "xxxxxxx"
            .CC = "xxxxxxx"
            .Display
        End With
        .Close savechanges:=False
        End With
 
    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr
 
End Sub
 
Sub createJpg_AT(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets("Dashboard_SAT").Activate
    Set xRgPic = ThisWorkbook.Worksheets("Dashboard_SAT").Range("a1:J56")
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets("Dashboard_SAT").ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets("Dashboard_SAT").ChartObjects(Worksheets("Dashboard_SAT").ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub