Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/автоматическая отправка письма при изменении ячейки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
автоматическая отправка письма при изменении ячейки
kanforka Дата: Воскресенье, 07.11.2021, 18:24 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Всем Привет! Помогите пожалуйста решить проблему.
В столбце А записывается исходное значение. В столбце В числа будут постоянно меняться автоматически путем запроса данных из сети или вбиваться вручную. В столбце С функция: если В больше или равно А тогда YES иначе NO. Числа будут постоянно сравниваться. Задача состоит в том, чтобы при изменении результата функции автоматически отправлялось письмо на почту с текстом в зависимости от результата функции. На просторах интернета нашел этот код, но отправляет письмо только если вручную менять ячейку С1. Я в программировании полный ноль, прошу помочь с решением.
[vba]
Код
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("C1")
    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
[/vba]
К сообщению приложен файл: 1457999.xlsm (17.2 Kb)
 
Ответить
СообщениеВсем Привет! Помогите пожалуйста решить проблему.
В столбце А записывается исходное значение. В столбце В числа будут постоянно меняться автоматически путем запроса данных из сети или вбиваться вручную. В столбце С функция: если В больше или равно А тогда YES иначе NO. Числа будут постоянно сравниваться. Задача состоит в том, чтобы при изменении результата функции автоматически отправлялось письмо на почту с текстом в зависимости от результата функции. На просторах интернета нашел этот код, но отправляет письмо только если вручную менять ячейку С1. Я в программировании полный ноль, прошу помочь с решением.
[vba]
Код
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("C1")
    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
[/vba]

Автор - kanforka
Дата добавления - 07.11.2021 в 18:24
bmv98rus Дата: Понедельник, 08.11.2021, 20:56 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4115
Репутация: 769 ±
Замечаний: 0% ±

Excel 2013/2016


Замечательный Временно просто медведь , процентов на 20.
 
Ответить
Сообщениекрос

Автор - bmv98rus
Дата добавления - 08.11.2021 в 20:56
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!