Note: The other languages of the website are Google-translated. Back to English

Як надіслати електронну пошту, якщо певна комірка змінена в Excel?

У цій статті йдеться про надсилання електронного листа через Outlook, коли клітинка в певному діапазоні змінено в Excel.

Надішліть електронне повідомлення, якщо комірка певного діапазону модифікована кодом VBA


Надішліть електронне повідомлення, якщо комірка певного діапазону модифікована кодом VBA

Якщо вам потрібно автоматично створити новий електронний лист із вкладеною активною книгою, коли комірку в діапазоні A2:E11 змінено на певному аркуші, наведений нижче код VBA може допомогти вам.

1. На аркуші, якому потрібно надіслати електронний лист на основі його модифікованої комірки в певному діапазоні, клацніть правою кнопкою миші вкладку аркуша, а потім клацніть Переглянути код з контекстного меню. Дивіться знімок екрана:

2. У спливаючому Microsoft Visual Basic для додатків вікно, скопіюйте та вставте нижче код VBA у вікно коду.

Код VBA: Надішліть електронне повідомлення, якщо в Excel змінено комірку у вказаному діапазоні

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("A2:E11")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

примітки:

1). У коді, A2: E11 - діапазон, який ви надішлете електронною поштою на основі.
2). Будь ласка, змініть текст електронної пошти, як вам потрібно xMailBody рядок у коді.
3). Замініть Адреса електронної пошти з адресою електронної пошти одержувача .To = "Адреса електронної пошти".
4). Змініть тему повідомлення в рядку .Subject = "Робочий аркуш змінено в" & ThisWorkbook.FullName.

3 Натисніть кнопку інший + Q клавіші одночасно, щоб закрити Microsoft Visual Basic для додатків вікна.

Відтепер будь-яка комірка в діапазоні A2: E11 модифікується, буде створено новий електронний лист із доданою оновленою книгою. І всі вказані поля, такі як тема, одержувач та тіло електронної пошти, будуть перелічені в електронному листі. Будь ласка, надішліть електронне повідомлення.

примітки: код VBA працює, лише якщо ви використовуєте Outlook як програму електронної пошти.


Статті по темі:


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2021 і 365. Підтримує всі мови. Легке розгортання на вашому підприємстві чи в організації. 30-денна безкоштовна пробна версія повних функцій. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (37)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
Я застряг у коді нижче VB. Я намагаюся отримати сповіщення електронною поштою для користувача, де дані були змінені. Електронна пошта працює, але коли я вношу будь-які зміни, електронна пошта ініціюється відразу, але мені потрібна електронна пошта, коли аркуш Excel збережено та закрито після внесення всіх змін для всіх користувачів, які вплинули. Також це має працювати для будь-якого з аркушів у всій книзі Excel.

Будь ласка, допоможіть...

Приватна підпорядкована робоча книга_BeforeSave(ByVal SaveAsUI як Boolean, Скасувати як Boolean)

'****Оголошення об'єктів і змінних******

Dim xRgSel As Range Dim xOutApp As Object Dim xMailItem As Object Dim xMailBody As String Dim mailTo As String

On Error Resume Next

Sheets("TargetSheet").Діапазон("TargetRange").Вибрати

Application.ScreenUpdating = Неправда Application.DisplayAlerts = Неправда

'Встановити xRg = Діапазон("A" & Rows.Count).End(xlUp).Row

Встановіть xRg = діапазон ("A2:DA1000")
Встановити xRgSel = Intersect(Target, xRg)


ActiveWorkbook.Save
'********** Відкриття програми Outlook************

Якщо не xRgSel - це нічого

Встановіть xOutApp = CreateObject("Outlook.Application")
Встановити xMailItem = xOutApp.CreateItem(0)

xMailBody = "Ячейка(и) " & xRgSel.Address(False, False) & _
" на робочому аркуші "" & Me. Name & "' були змінені на " & _
Format$(Зараз, "mm/dd/yyyy") & " at " & Format$(Зараз, "hh:mm:ss") & _
" від " & Environ$("ім'я користувача") & "."
'***********Пошук списку одержувачів**************

Якщо клітинки(xRgSel.Row, "A").Value = "Pankaj" Тоді

mailTo = "pank12***@gmail.com"

End If

Якщо клітинки(xRgSel.Row, "A").Value = "Nitin" Тоді

mailTo = "pank****@gmail.com"

End If

Якщо Cells(xRgSel.Row, "A").Value = "Chandan", Тоді

mailTo = "pakxro**@gmail.com"

End If
'************** Складання електронної пошти**************

За допомогою xMailItem

.Кому = mailTo
.Subject = "Робочий аркуш змінено в" & ThisWorkbook.FullName
.Body = xMailBody
'.Додатки.Додати (ця книга.Повне ім'я)
Відображення

Кінець з

Встановіть xRgSel = Нічого
Встановіть xOutApp = Нічого
Встановіть xMailItem = Нічого

End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Шановний Панкадж Шукла,
Опублікуйте своє запитання щодо Excel на нашому форумі: https://www.extendoffice.com/forum.html щоб отримати додаткову підтримку щодо Excel від нашого спеціаліста з Excel.
Цей коментар був мінімізований модератором на сайті
Мені вдалося створити макрос, однак у мене виникла проблема. Я хотів би автоматично надсилати електронний лист, коли клітинка досягає певного порогу. Клітинка — це формула. Коли сума розрахунку опускається нижче зазначеного порогу, це нічого не робить; однак, якщо я введу безпосередньо в клітинку, він обробить макрос, як було заплановано. Чи псує формула макрос?
Цей коментар був мінімізований модератором на сайті
Привіт, Сісі Джонс!
Спосіб у цій статті: як автоматично надсилати електронну пошту на основі значення комірки в Excel?
https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html може допомогти вам вирішити проблему.
Цей коментар був мінімізований модератором на сайті
Шановний адміністраторе,


Мені потрібна твоя допомога,



У мене є Excel для моніторингу деталей щоденної роботи, виконаної нашим працівником з поля, тож чи можна ініціювати повідомлення з аркуша Excel, якщо цей хлопець не зміг оновити дані в цьому аркуші Excel за певний час.
Цей коментар був мінімізований модератором на сайті
привіт,
Не можу допомогти з цим.
Цей коментар був мінімізований модератором на сайті
Якщо я хочу надіслати значення комірки замість адреси.. що мені змінити в коді?
Цей коментар був мінімізований модератором на сайті
привіт,
Ви можете спробувати наведений нижче код VBA.

Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Dim xRgSel як діапазон
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Заглушити xMailBody як рядок
On Error Resume Next
Application.ScreenUpdating = Невірний
Application.DisplayAlerts = False
Встановити xRg = діапазон ("A2:E11")
Встановити xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
Якщо не xRgSel - це нічого
Встановіть xOutApp = CreateObject("Outlook.Application")
Встановити xMailItem = xOutApp.CreateItem(0)
xMailBody = "Ячейка(и) " & xRgSel.Address(False, False) & _
xRgSel.Value & _
" на робочому аркуші "" & Me. Name & "' були змінені на " & _
Format$(Зараз, "mm/dd/yyyy") & " at " & Format$(Зараз, "hh:mm:ss") & _
" від " & Environ$("ім'я користувача") & "."

За допомогою xMailItem
.To = "Адреса електронної пошти"
.Subject = "Робочий аркуш змінено в" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
Відображення
Кінець з
Встановіть xRgSel = Нічого
Встановіть xOutApp = Нічого
Встановіть xMailItem = Нічого
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Що робити, якщо ми хочемо лише оновлені коментарі в цій клітинці, а не повне значення клітинки. Воно має показувати лише останні коментарі, додані в клітинку
Цей коментар був мінімізований модератором на сайті
Ви це зрозуміли?
Цей коментар був мінімізований модератором на сайті
Чудова інформація.
Питання щодо інформації, яку можна додати до електронного листа.
Використовуючи ваш приклад вище....

Якби у вас було значення F4, як би ви включили значення F4 в електронний лист, який було згенеровано під час зміни D4??
Цей коментар був мінімізований модератором на сайті
якщо мені потрібно надіслати весь цей рядок?
Цей коментар був мінімізований модератором на сайті
Я спробував вище код VBA: Надіслати електронну пошту, якщо клітинка у вказаному діапазоні змінена в Excel. Цей VBA працює для мене, крім надсилання електронної пошти. Коли дані змінюються в заданому діапазоні, автоматично створюється електронний лист із зміненими деталями клітинки. Однак електронний лист не надсилається автоматично одержувачу, і користувач повинен натиснути кнопку надіслати в електронному листі. Тут я дивлюся, що електронний лист має автоматично надсилатися одержувачам, коли воно створюється. Будь ласка, допоможіть мені надати код для цього. Велике дякую
Цей коментар був мінімізований модератором на сайті
Привіт Джиммі Джозеф!
Будь ласка, замініть рядок ".Display" на ".Send". Сподіваюся, що зможу допомогти. Дякую за коментар.
Цей коментар був мінімізований модератором на сайті
Привіт; чи є спосіб змінити текст, що відображається, використовуючи інформацію з інших комірок (з першого рядка та першого стовпця)? наприклад, якщо я зміню клітинку K15, я хочу включити в повідомлення інформацію про клітинки A15 і K1? що потрібно змінити в коді? дуже тобі дякую
Цей коментар був мінімізований модератором на сайті
привіт Лаона. ти дізнаєшся, як це можна зробити?
Цей коментар був мінімізований модератором на сайті
Привіт. Як змінити код, щоб повідомлення електронної пошти надсилалося на іншу адресу електронної пошти, якщо змінено інший діапазон комірок?
Цей коментар був мінімізований модератором на сайті
Чи є допомога щодо цього запиту? У мене така ж проблема. Я хочу додати кілька адрес електронної пошти на рядок, але коли я зміню один рядок, весь аркуш змінюється. Як я можу обмежити зміни лише одним рядком?
Цей коментар був мінімізований модератором на сайті
Редагувати рядок:
1). У коді A2:E11 – це діапазон, на основі якого ви будете надсилати електронні листи.
і
3). Замініть адресу електронної пошти адресою електронної пошти одержувача в рядку .To = "Адреса електронної пошти".

Працює нормально.
Цей коментар був мінімізований модератором на сайті
Чи можете ви пояснити це далі. Як повторити код, щоб надіслати на інший електронний лист на основі іншого діапазону, який змінюється. Я спробував скопіювати та вставити код нижче та змінити відповідно до вашого коментаря, але все одно, здається, лише перший діапазон виконує команду та пише електронний лист.
Цей коментар був мінімізований модератором на сайті
Хтось має відповідь на це?
Цей коментар був мінімізований модератором на сайті
Привіт, я намагався надіслати електронні листи на своєму аркуші, використовуючи одне значення, змінене на аркуші. Якщо в стовпці H статус буде змінено на ="4", ідентифікатор замовлення зліва потрібно надіслати одному користувачеві. Аркуш працює динамічно, тому у мене є діапазон від D9:D140, де зберігаються ідентифікатори замовлення та зміни статусу вносяться в тому ж діапазоні на H9:H140. Як я можу досягти мети та надіслати ідентифікатор замовлення своєму клієнту, коли статус було змінено на ="4" ?
Цей коментар був мінімізований модератором на сайті
Чи можна було б відобразити іншу опорну клітинку в xMailBody в тому самому стовпці замість зміненої адреси осередку??
Цей коментар був мінімізований модератором на сайті
Привіт Сем! Ви маєте на увазі вибрати опорну клітинку випадковим чином у тому самому стовпці зміненої адреси комірки? Або вручну ввести опорну клітинку в рядку xMailBody коду? Легко вручну ввести опорну клітинку в коді, просто візьміть опорну клітинку в подвійні лапки, як показано нижче: xMailBody = "Cell(s)" & "D3" & ", " & "D8" & _

Цей коментар був мінімізований модератором на сайті
Чи можна змінити це, щоб він відображав електронну пошту, лише якщо клітинка в діапазоні була змінена на "Так". Хотілося б, щоб це нічого не робило, якщо це будь-яка інша цінність.
Цей коментар був мінімізований модератором на сайті
Дякую за код, цей код працює, коли я вводжу значення та натискаю enter. Але в моєму випадку клітинка автоматично заповнюється формулою, і коли значення досягається, вона не відкриває електронного листа, тому код не працює в цьому випадку. Заздалегідь спасибі!
Цей коментар був мінімізований модератором на сайті
Привіт, Хакана,
Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, спробуйте. Спасибі за ваш відгук.

Приватний допоміжний робочий лист_Change(ByVal Target As Range)
'Оновлено Extendoffice 2022/04/15
Dim xRgSel як діапазон
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Заглушити xMailBody як рядок
Dim xBoolean Як Boolean
Dim xItsRG як діапазон
Dim xDDs як діапазон
Dim xDs As Range
On Error Resume Next
Application.ScreenUpdating = Невірний
Application.DisplayAlerts = False
xBoolean = Неправда
Встановіть xRg = діапазон ("E2:E13")

Встановіть xItsRG = Intersect(Target, xRg)
Встановіть xDDs = Intersect(Target.DirectDependents, xRg)
Установіть xDs = Intersect(Target.Dependents, xRg)
Якщо ні (xItsRG — ніщо), то
Встановіть xRgSel = xItsRG
xBoolean = Правда
ElseIf Not (xDDs Is Nothing) Тоді
Встановіть xRgSel = xDDs
xBoolean = Правда
ElseIf Not (xDs Is Nothing) Тоді
Встановіть xRgSel = xDs
xBoolean = Правда
End If


ActiveWorkbook.Save
Якщо xBoolean Тоді
Debug.Print xRgSel.Address


Встановіть xOutApp = CreateObject("Outlook.Application")
Встановити xMailItem = xOutApp.CreateItem(0)
xMailBody = "Ячейка(и) " & xRgSel.Address(False, False) & _
" на робочому аркуші "" & Me. Name & "' були змінені на " & _
Format$(Зараз, "mm/dd/yyyy") & " at " & Format$(Зараз, "hh:mm:ss") & _
" від " & Environ$("ім'я користувача") & "."

За допомогою xMailItem
.To = "Адреса електронної пошти"
.Subject = "Робочий аркуш змінено в" & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
Відображення
Кінець з
Встановіть xRgSel = Нічого
Встановіть xOutApp = Нічого
Встановіть xMailItem = Нічого
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, я створив подібний код, але я хотів би *** умову, коли якщо значення комірки буде видалено, це не надсилатиме електронний лист, коли його буде збережено/закрито. Він надішле електронний лист лише тоді, коли було введено значення комірки. Ви знаєте, як це зробити? Це мій код:

КОД ДЛЯ АВТОМАТИЧНОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ ЕЛЕКТРОННОЇ електронної пошти КОДОМУ, КОГДА EXCEL WORKBOOK ОНОВЛЕНО

КОД АРКУЛЯ:

Явний параметр «Діапазон подій зміни робочого аркуша Excel
Приватний допоміжний робочий лист_Change(ByVal Target As Range)
Якщо не перетинається(ціль, діапазон("C3:D62")) - це нічого
'Target.EntireRow.Interior.ColorIndex = 15
Діапазон ("XFD1048576"). Значення = 15
End If
Якщо не перетинається(ціль, діапазон("I3:J21")) - це нічого
'Target.EntireRow.Interior.ColorIndex = 15
Діапазон ("XFD1048576"). Значення = 15
End If
End Sub


КОД ЗОШИТА:

Приватна підпорядкована робоча книга_BeforeClose(Скасувати як логічне значення)
Якщо Me.Saved = False, тоді Me.Save

Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Dim xName як рядок

Якщо діапазон("XFD1048576").Значення = 15 Тоді
On Error Resume Next
Встановіть xOutApp = CreateObject("Outlook.Application")
Встановити xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
За допомогою xMailItem
.Кому = "електронна пошта"
.CC = ""
.Subject = "повідомлення"
.Body = "повідомлення!"
.Додатки.*** xName
Відображення
'.відправити
Кінець з
End If
Встановіть xMailItem = Нічого
Встановіть xOutApp = Нічого



End Sub

Приватна додаткова робоча книга_Open()
Діапазон("XFD1048576").Очистити
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт всім,

der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die geändert wurden? So wie es jetzt ist ,würde er jede geänderte Zelle einzeln senden. Dies ist dann problematisch wenn zB 10 Zellen angepasst werden was 10 E-Mail bedeuten würde. Und gibt es die Möglichkeit, die gesamte geänderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die Änderung nicht mehr finden.
Цей коментар був мінімізований модератором на сайті
Привіт Esser123,
Наступні коди VBA можуть допомогти. Після зміни клітинок у вказаному діапазоні та збереження робочої книги з’явиться повідомлення електронної пошти зі списком усіх змінених клітинок у тілі електронного листа, а робочу книгу також буде вставлено як вкладення в електронний лист. Виконайте наступні дії:
1. Відкрийте робочий аркуш, який містить клітинки, на основі яких ви хочете надіслати електронні листи, клацніть правою кнопкою миші вкладку аркуша та виберіть Переглянути код з меню правої кнопки миші. Потім скопіюйте наступний код у вікно аркуша (коду).
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. У редакторі Visual Basic двічі клацніть ThisWorkbook на лівій панелі, а потім скопіюйте наведений нижче код VBA до ThisWorkbook (Code) вікна.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        With xMailItem
            .To = "Email Address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Цей коментар був мінімізований модератором на сайті
Мені потрібна допомога щодо запуску електронного листа з невеликими змінами. Замість числового значення або введення інформації в клітинку вручну, клітинки в стовпці B зміняться на «Y», викликані формулою в інших клітинках цього рядка. Формула для стовпця B має такий вигляд: =IF([@[Кількість на складі]]>[@[Рівень повторного замовлення]],,"Y"), що показує, що запасів мало на складі та потребує повторного замовлення. Мені потрібно запустити автоматичний електронний лист, коли значення клітинки в стовпці B змінюється на «Y», тому я автоматично отримаю сповіщення електронною поштою про низький запас. Я спробував усе, що міг придумати, змінивши вже надані коди, але, здається, нічого не спрацювало... будь ласка, допоможіть!
Цей коментар був мінімізований модератором на сайті
Привіт Кетрін Ф.
Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, спробуйте. Дякуємо за коментар.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Private Sub Worksheet_Calculate()
Dim xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт і спасибі за цей підручник.
J'ai cependant une difficulté pour l'application de la plage de recherche.
У коді потрібно виконати перевірку поля C2:C4.
Tout funkcionalne bien si je modifie C2, C3 або C4 унікальний. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Наприклад, ви змінюєте C2 і C4 без модифікатора C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Заздалегідь дякуємо.

Приватний допоміжний робочий лист_Change(ByVal Target As Range)
'Оновлено Extendoffice 20220921
Dim xAddress як рядок
Dim xDRg, xRgSel, xRg As Range

xAddress = "C2:C4"
Встановити xDRg = Range(xAddress)
Встановити xRgSel = Intersect(Target, xDRg)
Помилка GoTo Err1
Якщо не xRgSel - це нічого
Якщо ThisWorkbook.gChangeRange = "" Тоді
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Ще
Встановити xRg = Range(ThisWorkbook.gChangeRange)
Встановити xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub


-----

Варіант явний
Загальнодоступний gChangeRange як рядок
Приватна підпорядкована книга_AfterSave(ByVal Success As Boolean)
'Оновлено Extendoffice 20220921
Dim xRgSel, xRg As Range
Зменшіть xOutApp як об’єкт
Змінити xMailItem як об’єкт
Заглушити xMailBody як рядок
'При помилці Відновити далі
Помилка GoTo Err1
Встановити xRg = діапазон (gChangeRange)
Якщо ні, то xRg – це нічого
Встановіть xOutApp = CreateObject("Outlook.Application")
Встановити xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address(False, False) & vbCrLf & vbCrLf & "Сердечність"
За допомогою xMailItem
.To = "x.xxxxxx@xxxx.fr"
.Subject = "Données modifiées " & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (This Workbook.FullName)
Відображення
Кінець з
Встановіть xRgSel = Нічого
Встановіть xOutApp = Нічого
Встановіть xMailItem = Нічого
End If
Err1:
gChangeRange = ""
End Sub
Цей коментар був мінімізований модератором на сайті
Я хотів би надіслати електронний лист 5 людям. Який роздільник використовується між адресами електронної пошти?
Цей коментар був мінімізований модератором на сайті
Привіт Джо,
Розділяйте адреси електронної пошти крапкою з комою.
Цей коментар був мінімізований модератором на сайті
Ось ще питання. Якщо одна клітинка змінюється, вона надсилає електронний лист. якщо 3 клітинки змінюються, він надсилає 3 електронні листи. Як зупинити це, щоб він надсилав лише 1 електронний лист після завершення редагування?
Цей коментар був мінімізований модератором на сайті
Привіт Джо,
Припустімо, ви вказали діапазон як "A2:E11" у коді. Як я можу перевірити, чи зроблено всі зміни?
There are no comments posted here yet
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL