Problème VBA 2016 vers 2010 (Excel-Outlook)

Bonjour,

Je viens vous demander de l'aide car je suis vraiment dans un cul de sac

J'ai fais (avec toute l'aide de nos amis des forums du net ) une macro qui lorsque je suis sur Excel, et suite à un clique sur un bouton, ouvre Outlook, colle une partie de mes cellules en image dans le corps du mail et rajoute aussi cette image en pièce jointe.

Je précise que j'ai tout fais sur Excel 2016. Hors lorsque je vais sur le PC de mon collègue, l'image qui devrait être en pièce jointe ne se met pas mais en plus se colle en dessous la première dans le corps du mail.

AIDEZ MOI SVP !!

Sub ENVOIDEMAIL()

If Worksheets("TOUS LES CLIENTS").[S13] = ("1") Or Worksheets("TOUS LES CLIENTS").[S13] = ("2") Then

Dim sh As Worksheet

Dim rng As Range

Dim chartobj As ChartObject

Dim output As String

Dim zoom_coef As Double

' référence sur la feuille qui contient la plage à exporter

Set sh = Worksheets("TOUS LES CLIENTS")

' le fichier image

output = "C:\Windows\Temp\" & "Flash info.jpg"

' el zoom

zoom_coef = 100 / sh.Parent.Windows(1).Zoom

' sélectionner la plage à exporter

Set rng = sh.Range("A1:M42").Cells

' copier dans le presse-papier

rng.CopyPicture xlPrinter

Set chartobj = sh.ChartObjects.Add(0, 0, rng.Width * zoom_coef, rng.Height * zoom_coef)

chartobj.Activate

chartobj.Chart.Paste

' exporter l'image

chartobj.Chart.Export output

' supprimer

chartobj.Delete

End If

If Worksheets("TOUS LES CLIENTS").[S13] = ("2") Then

Dim sh2 As Worksheet

Dim rng2 As Range

Dim chartobj2 As ChartObject

Dim output2 As String

Dim zoom_coef2 As Double

' référence sur la feuille qui contient la plage à exporter

Set sh2 = Worksheets("TOUS LES CLIENTS")

' le fichier image

output2 = "C:\Windows\Temp\" & "Flash info2.jpg"

' el zoom

zoom_coef2 = 100 / sh2.Parent.Windows(1).Zoom

' sélectionner la plage à exporter

Set rng2 = sh2.Range("A44:M85").Cells

' copier dans le presse-papier

rng2.CopyPicture xlPrinter

Set chartobj2 = sh2.ChartObjects.Add(0, 0, rng2.Width * zoom_coef2, rng2.Height * zoom_coef2)

chartobj2.Activate

chartobj2.Chart.Paste

' exporter l'image

chartobj2.Chart.Export output2

' supprimer

chartobj2.Delete

End If

If Worksheets("TOUS LES CLIENTS").[R11] = "Tous les clients" Then Worksheets("ADRESSES MAIL").[G2].AutoFilter field:=7, Criteria1:=Array("IMPAIRE", "PAIRE", "HEBDOMADAIRE"), Operator:=xlFilterValues Else If Worksheets("TOUS LES CLIENTS").[R11] = "Clients impaire" Then Worksheets("ADRESSES MAIL").[G2].AutoFilter field:=7, Criteria1:=Array("IMPAIRE"), Operator:=xlFilterValues Else If Worksheets("TOUS LES CLIENTS").[R11] = "Clients paire" Then Worksheets("ADRESSES MAIL").[G2].AutoFilter field:=7, Criteria1:=Array("PAIRE"), Operator:=xlFilterValues Else If Worksheets("TOUS LES CLIENTS").[R11] = "Clients mixte" Then Worksheets("ADRESSES MAIL").[G2].AutoFilter field:=7, Criteria1:=Array("HEBDOMADAIRE"), Operator:=xlFilterValues Else If Worksheets("TOUS LES CLIENTS").[R11] = "Interne" Then Worksheets("ADRESSES MAIL").[G2].AutoFilter field:=1, Criteria1:=Array("1"), Operator:=xlFilterValues

Dim Adresse As String

Dim i As Integer

Sheets("ADRESSES MAIL").Select

Columns("F:F").Select

Selection.Replace What:="xxx@gmail.com", Replacement:="", _

LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _

False, ReplaceFormat:=False

Worksheets("ADRESSES MAIL").Activate

'Vérification du contenu de la cellule

Adresse = ""

For i = 2 To 2000

If Range("F" & i).Value <> "" And Not Range("F" & i).Rows.Hidden Then

Adresse = Adresse & Range("F" & i) & ";"

End If

Next i

'copie le résultat dans une autre feuille

Worksheets("TOUS LES CLIENTS").Activate

Cells(15, 23) = Adresse

If Worksheets("TOUS LES CLIENTS").[S13] = ("1") Or Worksheets("TOUS LES CLIENTS").[S13] = ("2") Then

Dim Img As String, Plage As Range, PathTmp As String

PathTmp = Environ$("temp") & "\"

Img = "Image.jpg"

Set Plage = Range("A1:M42")

'Création d'un fichier image dans le répertoire temporaire

Plage.CopyPicture

With ActiveSheet.ChartObjects.Add(0, 0, Plage.Width, Plage.Height)

.Activate

.Chart.Paste

.Chart.Export PathTmp & Img, "JPG"

End With

ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete

End If

If Worksheets("TOUS LES CLIENTS").[S13] = ("2") Then

Dim Img2 As String, Plage2 As Range, PathTmp2 As String

PathTmp2 = Environ$("temp") & "\"

Img2 = "Image2.jpg"

Set Plage2 = Range("A44:M85")

'Création d'un fichier image dans le répertoire temporaire

Plage2.CopyPicture

With ActiveSheet.ChartObjects.Add(0, 0, Plage2.Width, Plage2.Height)

.Activate

.Chart.Paste

.Chart.Export PathTmp2 & Img2, "JPG"

End With

ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete

End If

Set OutApp = CreateObject("outlook.application")

Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail

.To = Sheets("TOUS LES CLIENTS").[W15] & Sheets("TOUS LES CLIENTS").[W28]

'.CC =

'.BCC =

.Subject = "Flash info" & " " & Worksheets("TOUS LES CLIENTS").Range("S9")

If ActiveSheet.[S13] = 1 Then .Attachments.Add ("F:\1 - COMMERCIAL\FLASH INFO DEVIC\ENREGISTREMENTS\DEFINITIFS\" & Worksheets("TOUS LES CLIENTS").Range("S9") & ".jpg") Else If ActiveSheet.[S13] = 1 Or ActiveSheet.[S13] = 2 Then .Attachments.Add ("F:\1 - COMMERCIAL\FLASH INFO DEVIC\ENREGISTREMENTS\DEFINITIFS\" & Worksheets("TOUS LES CLIENTS").Range("S9") & ".jpg") And ("F:\1 - COMMERCIAL\FLASH INFO DEVIC\ENREGISTREMENTS\DEFINITIFS\" & Worksheets("TOUS LES CLIENTS").Range("S9") & " 2" & ".jpg")

If ActiveSheet.[S13] = 1 Then .Attachments.Add PathTmp & Img, olByValue, 0 Else If ActiveSheet.[S13] = 1 Or ActiveSheet.[S13] = 2 Then .Attachments.Add PathTmp & Img, olByValue, 0 And PathTmp2 & Img2, olByValue, 0

.HTMLBody = "<span LANG=FR><p class=style2>" _

& "<font FACE=Calibri SIZE=3>Bonjour,<br><br>" _

& "Veuillez trouver ci-dessous un flash info." _

& Format(JourJ, "dd/mm/yyyy") & "<br><br>" _

& "Salutations<br><br>" _

& "<img src='cid:" & Img & "'</font></span>" _

& "<img src='cid:" & Img2 & "'</font></span>"

.Display

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Wahou

Bonjour Raskar, sacré lascar !

Je félicite celui qui lira jusqu'au bout la macro.

Bon, pour ma part :

  • cela ne m'étonne pas que les fichiers image apparaissent parfois en dessous du mail même si elles sont en pièces jointes. C'est aussi une facilité donnée au lecteur. Du coup est-ce nécessaire de dupliquer (dans le corps du mail et en PJ)
  • pourquoi ne mets-tu pas les données directement dans le fichier sans passer par une image; on peut faire une mise en forme en html des données (en les mettant sous forme d'une <table>) ? parce que, en plus, mettre une image c'est vraiment pas pratique pour le lecteur et c'est lourd pour les messageries.
  • ou alors, s'il s'agit d'un flash info, le mettre en PJ en pdf ?
  • autre solution, faire un copier/coller avec sendkeys (un peu plus pointu)

Bonjour Steelson,

Merci déjà d'avoir regardé

Pour moi c'est OK si je peux le mettre en PDF mais alors comment je fais pour ajuster mon image sur une feuille A4 ? Car j'ai essayé de le mettre en PDF (pas encore sur la version 2010) mais déjà mon premier problème est que le document est coupé.

Je viens de modifier pour que cela me crée un PDF, je suis arrivé à ajuster sur une page et à centrer dans les 2 sens. Chez moi niquel en 2016 mais idem, cela ne s'accroche pas sur le 2010.

Le pdf, c'est comme une impression, il faut définir la "zone d'impression" et les paramètres d'ajustement à une page, ensuite cela s'ajuste.

Que veux-tu dire par "cela ne s'accroche pas sur le 2010" ?

Ok Steelson et merci beaucoup.

Bon j'ai réussi à mettre en pièce jointe sur Outlook 2010 en pdf. Maintenant, puis-je imprimer 2 sélections et ne faire qu'un seul PDF avec les 2 pages ?

Le pdf, c'est comme une impression ... donc configure ton impression pour avoir les 2 pages à la suite. Cela passe sans doute par la sélection de 2 onglets ? sinon donne un fichier ...

Rechercher des sujets similaires à "probleme vba 2016 2010 outlook"