Блог

Главная - Вопросы по программированию - Можно ли встроить несколько диапазонов из листа в виде изображения .emf в текст письма Outlook?

Можно ли встроить несколько диапазонов из листа в виде изображения .emf в текст письма Outlook?

#excel #vba #outlook

#excel #vba #outlook

Вопрос:

Я пытаюсь встроить несколько диапазонов из листа в виде изображений .emf в текст письма Outlook. Я попытался настроить приведенный ниже код Рона де Брюина, который показан для вставки диапазонов в формате .jpg, но это выдает ошибку «Изображение в данный момент не может быть отображено».

Любая помощь здесь будет оценена. Пожалуйста, ознакомьтесь с кодом Рона де Брюина ниже, как показано на его веб-сайте:

 
Sub Mail_small_Text_And_JPG_Range_Outlook()
    'Ron de Bruin, 25-10-2019
    'This macro use the function named : CopyRangeToJPG
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MakeJPG As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Customer" amp; "<br><br>" amp; _
        "Below you find a picture of your data." amp; "<br>" amp; _
        "If you need more information let me know." amp; "<br><br>" amp; _
        "Regards Ron<br>"
              
    'Create JPG file of the range
    'Only enter the Sheet name and the range address
    MakeJPG = CopyRangeToJPG("Sheet1", "A1:H50")

    If MakeJPG = "" Then
        MsgBox "Something go wrong, we can't create the mail"
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Exit Sub
    End If

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Attachments.Add MakeJPG, 1, 0
        'Note: Change the width and height as needed
        .HTMLBody = "<html><p>" amp; strbody amp; "</p><img src=""cid:NamePicture.jpg"" width=750 height=700></html>"
        .Display 'or use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub



Function CopyRangeToJPG(NameWorksheet As String, RangeAddress As String) As String
    'Ron de Bruin, 25-10-2019
    Dim PictureRange As Range

    With ActiveWorkbook
        On Error Resume Next
        .Worksheets(NameWorksheet).Activate
        Set PictureRange = .Worksheets(NameWorksheet).Range(RangeAddress)
        
        If PictureRange Is Nothing Then
            MsgBox "Sorry this is not a correct range"
            On Error GoTo 0
            Exit Function
        End If
        
        PictureRange.CopyPicture
        With .Worksheets(NameWorksheet).ChartObjects.Add(PictureRange.Left, PictureRange.Top, PictureRange.Width, PictureRange.Height)
            .Activate
            .Chart.Paste
            .Chart.Export Environ$("temp") amp; Application.PathSeparator amp; "NamePicture.jpg", "JPG"
        End With
        .Worksheets(NameWorksheet).ChartObjects(.Worksheets(NameWorksheet).ChartObjects.Count).Delete
    End With
    
    CopyRangeToJPG = Environ$("temp") amp; Application.PathSeparator amp; "NamePicture.jpg"
    Set PictureRange = Nothing
End Function

Комментарии:

1. Почему бы вам не начать с изображений в формате .jpg, пока вы не заработаете код и не отправите эти изображения в формате .jpg. Затем настройте код для обработки изображений .emf.

2. Привет, мне удалось заставить код работать с изображениями .jpg, но он больше не работает, когда я корректирую код, изменяя all .jpg на .emf. Может быть, я чего-то не хватает при настройке кода?