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
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 ...