Envoi d'image de cellules par mail, Excel 2007

Bonsoir,

Help ! Après plus d'une semaine de recherche, j'ai enfin trouvé un code qui s'approche le plus de ce que je voudrais. Enfin, à un détail près...

Mon but est de copier une plage de cellules et de la coller en tant qu'image dans un mail. Le code fonctionne mais ne colle pas en tant qu'image.

On peut sélectionner les cadres et en plus ils ne sont pas tous bien alignés.

Quelqu'un a -t-il une solution, pas trop compliquée, pour que le collage se fasse en tant qu'image ? Et que l'on puisse également redimensionner cet image car elle prend un peu beaucoup de place.

Je joins le fichier, le graphique est en bas, en o365, car j'ai supprimé les données personnelles sans toucher à la structure.

Merci.

image

Bonjour Pegpas

Vous devriez trouver votre bonheur dans le code du fichier ici

https://www.excel-pratique.com/fr/telechargements/utilitaires/pdf-email-vba-excel-no508

A+

Bonjour Bruno,

C'est exactement ce que je cherchais, merci beaucoup (1 semaine de perdue, j'aurais dû demandé plus tôt). En revanche, pour l'instant, j'ai un message d'erreur, une msgbox qui me dit que la plage n'est pas correcte. Je vois pas où est le problème. Une idée ?

Et sinon, on est d'accord que je ne doit rien toucher à la fonction ?

' Ce code permet de créer une image d'une plage donnée et de l'intégrer au mail
Sub EnvoiImageParMail()
  Dim OutApp As Object, OutMail As Object
  Dim StrHTML As String, StrSignature As String, MakeJPG As String

  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  ' Créer une instance Outlook et Mail
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(olMailItem)
  ' Créer le fichier JPG de la plage
  MakeJPG = CopyRangeToJPG("PlageInPictureToMail", "O365:AE399")
  If MakeJPG = "" Then
    MsgBox "Quelque chose s'est mal passé, impossible de créer le mail"
    With Application
      .EnableEvents = True
      .ScreenUpdating = True
    End With
    Exit Sub
  End If
  ThisWorkbook.Sheets("PRODUCT3").Activate
  With OutMail
    .BodyFormat = olFormatHTML  ' Format HTML
    .Display  ' Afficher le mail pour la signature (si insertion auto)
    ' Mémoriser le code HTML avec la signature
    StrSignature = .HTMLBody
    '
    .To = Range("AW367")
    '.CC = "LaCopie@fai.fr"
    '.BCC = "LaCopieCachee@fai.fr"
    .Subject = "Suivi chantier : " & Range("D1")
    StrHTML = "Bonjour, <br>" & Range("AT367")
    .Attachments.Add MakeJPG, 1, 0
    ' Note: On peut changer la taille de l'image intégrée
    .HTMLBody = "<html><p>" & StrHTML & "</p><img src=""cid:NamePicture.jpg"" width=" & ImgW _
      & " height=" & ImgH & ">" & StrSignature & "</html>"
    ' Pour l'envoyer, enlever le commentaire
    '.SendSub
  End With
  ' Effacer les variable objet
  Set OutMail = Nothing: Set OutApp = Nothing
  ' Supprimer le fichier JPG
  Kill MakeJPG
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With

  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

Private Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
  Dim PictureRange As Range
  ' Avec ce classeur
  With ActiveWorkbook
    On Error Resume Next
    '.Worksheets(NameWorksheet).Activate
    Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
    If PictureRange Is Nothing Then
      MsgBox "Désolé, mais la plage n'est pas correcte"
      On Error GoTo 0
      Exit Function
    End If
    ' Copier la plage
    PictureRange.CopyPicture
    ' Mémoriser les dimensions
    ImgW = PictureRange.Width
    ImgH = PictureRange.Height
    ' Créer un graphique vide et y coller l'image
    With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, _
      PictureRange.Top, PictureRange.Width, PictureRange.Height)
      .Activate
      .Chart.Paste
      .Chart.Export Environ$("temp") & Application.PathSeparator & "NamePicture.jpg", "JPG"
    End With
    .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
  End With
  CopyRangeToJPG = Environ$("temp") & "\NamePicture.jpg"
  Set PictureRange = Nothing
End Function

Bon j'avance, j'ai vu une option explicite que j'ai copiée collée. Je vais un peu plus loin mais maintenant c'est cette ligne qui pose problème :

    .HTMLBody = "<html><p>" & StrHTML & "</p><img src=""cid:NamePicture.jpg"" width=" & ImgW _
      & " height=" & ImgH & ">" & StrSignature & "</html>"

l'erreur c'est : "Valeur non définie" et il met en surbrillance "ImgW"

Ai-je encore oublié de mettre quelque chose ?

J'ai trouvé ! C'est juste que j'étais mal réveillée ! Je n'ai pas mis la bonne Option Explicit. Pourtant je pouvais pas la louper....

Un café et hop le cerveau parait plus clair.

Encore un grand merci !

Rechercher des sujets similaires à "envoi image mail 2007"