vba - создать отдельное письмо с индивидуальной диаграммой для каждого получателя в списке - PullRequest
Новая
       11

vba - создать отдельное письмо с индивидуальной диаграммой для каждого получателя в списке

0 голосов
/ 21 апреля 2019

Я пытаюсь автоматически сгенерировать электронную почту для каждого получателя на листе Excel (лист 4). лист 1 включает в себя диаграмму для получателя электронной почты на листе 4 ячейка B1 .Sheet 2 включает диаграмму для электронной почты получателя на листе 4 ячейка B2 . Лист 3 такой же, как и выше.

Я застрял в процессе экспорта, потому что, когда я набираю коды, это приводит меня к ошибке, а затем завершается.

Пожалуйста, помогите, спасибо!

у меня по 1 диаграмме на каждом листе (лист 1,2,3) и я должен отправить диаграмму на листе 1 клиенту 1 (B1 на листе 4)

Sub demochart () 

Dim OutApp As Object
Dim OutMail As Object
Dim fname As String
Dim cell As Range
Dim lastrow As Integer
lastrow = Range("A1").End(xlDown).Row
Dim i As Integer

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
    For i = 1 To lastrow
    fname = ThisWorkbook.Path & "\clientchart.gif"
    ActiveWorkbook.Worksheets(i).ChartObjects("chart 1").Chart.Export _
    Filename:=fname, filtername:="GIF"

    If Range("B" & i).Value Like "?*@?*.?*" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = Range("B" & i).Value
            .Subject = "Reminder for" & cell.Offset(0, -1)
            .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            .Attachments.Add fname
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send  'Or use Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing

    End If
Next i

Очистка: Set OutApp = Nothing Application.ScreenUpdating = True Конец Sub

каждому клиенту должен быть график и основной текст

...