Excel VBA - Как запустить один и тот же макрос одновременно на всех листах - создать одно электронное письмо - PullRequest
Новая
       17

Excel VBA - Как запустить один и тот же макрос одновременно на всех листах - создать одно электронное письмо

0 голосов
/ 31 января 2019

Я продолжаю свою работу, начиная с первого вопроса здесь:

Excel VBA - Outlook Email - тело, созданное из строк, имеющих определенное значение

Теперь у меня есть еще одинпроблема.Я хочу повторить приведенные ниже МАКРОСЫ на всех ЛИСТАХ моего файла.

В частности, как я могу повторить эту функцию на разных ЛИСТАХ, просто нажав 1 кнопку, присутствующую на всех листах?Все листы имеют одинаковую структуру.

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

Данные следует копировать, начиная с 1-го листа, напримерТЕСТ (1) до последнего листа, ТЕСТ (9).

Электронное письмо, сгенерированное после этого процесса, должно быть ТОЛЬКО единым.

Определить диапазон тела 

Sub EmailRange()

Dim Initial As Range, Final As Range, nCell As Range

On Error Resume Next
    Set Initial = Sheets("TEST").Application.InputBox("Range", xTitleId, "B1:K20", Type:=8)
On Error GoTo 0

For Each nCell In Initial.Resize(Initial.Rows.Count, 1)
    If nCell.Offset(, -1) = "X" Then
        If Not Final Is Nothing Then
            Set Final = Union(Final, nCell.Resize(1, Initial.Columns.Count))
        Else
            Set Final = nCell.Resize(1, Initial.Columns.Count)
        End If
    End If
Next nCell

If Not Final Is Nothing Then
    MAIL Final
Else
    MsgBox "ATTENZIONE!!!" & vbNewLine & "Seleziona un range di celle valido.", vbOKOnly
End If

End Sub

Отправьте электронное письмо сдиапазон 

Sub MAIL(Final as Range)

Dim OutApp As Object, OutMail As Object
Dim StrBodyIn As String, StrBodyEnd As String

StrBodyIn = "Bonjour," & "<br>" & " " & "<br>" & "Buongiorno," & "<br>"
StrBodyEnd = " " & "<br>" & "Cordialement" & "<br>" & " " & "<br>" & Range("M2") & "<br>"

Application.EnableEvents = False
Application.ScreenUpdating = False

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

    On Error Resume Next
        With OutMail
            .To = "email@gmail.com"
            .CC = ""
            .BCC = ""
            .Subject = "SITUATION"
            .HTMLBody = "<p style='font-family:calibri;font-size:16'>" & StrBodyIn & RangetoHTML(Final) & "<p style='font-family:calibri;font-size:16'>" & StrBodyEnd
            .Display 'or use .Send
        End With
    On Error GoTo 0

  Set OutMail = Nothing
  Set OutApp = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Я пробовал что-то подобное, но это не работает: 

For I = 1 To Worksheets.Count
    Sheets(I).Select


***[...]CODE OF "Determine the body range"***

    Next I
Sheets("TEST(I)").Select
...