@ MathieuGuindon дал очень мудрый совет в комментариях, которые я приведу здесь:
НЕ при любых обстоятельствах не вводите обработчики событий вручную.
не уверен, как реализовать - единственное отличие состоит в том, что вы получаете параметр Sh, содержащий ссылку на измененный лист..... и это бесполезно, потому что вы уже можете получить это с Target.Parent.Единственное, о чем вам нужно беспокоиться, это о неявных ссылках ActiveSheet
Используйте вашу VBA IDE (ту версию / приложение / окно, из которой вы нашли свой скриншот).Откройте код для «ThisWorkbook».В верхней части этого окна кода вы увидите два раскрывающихся списка.
При выборе «Рабочая книга» в левом раскрывающемся списке и «SheetChange» в правом раскрывающемся списке автоматически будет опубликован этот код:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub
Как видите, Target используется, а не Source, в автоматизированном тексте.Так что большая часть вашего кода не изменилась.В качестве примечания вы можете изменить его на «Source» или «FrostyTheSnowman» (спасибо - @MathieuGuindon), а затем соответствующим образом изменить свой код, но зачем делать дополнительную работу для себя (см. Примечание 1 в конце).
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then
If IsDate(Target.Value) And Target.Value > 0 Then
targetRow = Target.Row
offsetRow = Target.Offset(9, 0).Row
Dim bIsNinthRow As Boolean
Dim ModResult As Long
bIsNinthRow = False
ModResult = (targetRow - 13) Mod 9
If ModResult = 0 Then bIsNinthRow = True
If bIsNinthRow Then Call Mail_small_Text_Outlook(targetRow, offsetRow)
End If
End If
End Sub
Как видно из вышесказанного, я сделал только одно небольшое изменение - это квалифицирует одно утверждение.
If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then
Я мог бы также использовать объект Sh (Intersect(Target, Sh.Range("L13:L5000"))), однако, для спокойствия потребуется проверка типов.
Но
Ваш текущий дизайн имеет небольшой недостаток - и это в вашей вспомогательной функции Sub Mail_small_Text_Outlook(targetRow, offsetRow).
Вы передаете два варианта в рутину, вы не используете эти варианты (что в настоящее время является для вас благословением), и мы не можем сказать, для чего они предназначены.Важно отметить, что ваш код использует конструкцию ActiveCell - но вы не можете гарантировать, какой будет активная ячейка, когда вы вызываете код.
У вас есть кости здесь, определите точный диапазон (или еще лучше,фактическое значение), которое вы хотите использовать в Mail_small_Text_Outlook, а затем использовать его.Это делает процедуру намного более пригодной для повторного использования в более позднюю дату, чем ваша текущая конструкция, которая опирается на жестко закодированное смещение.
Sub Mail_small_Text_Outlook(ByVal dataElement1 as String, ByVal dataElement2 as String) 'Meaningful names and types required, I am guessing.
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hello" & vbNewLine & vbNewLine & _
"This client is now Committed & Complete and ready for your attention" & vbNewLine & vbNewLine & _
"Renew As Is?" & vbNewLine & _
"Adding Changing Groups?"
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Committed & Complete" & " " & dataElement1 & " " & dataElement2
.Body = xMailBody
.Display 'or use .Send
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Это означает небольшое изменение в вашей подпрограмме 'Change':
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Target.Parent.Range("L13:L5000")) Is Nothing Then
If IsDate(Target.Value) And Target.Value > 0 Then
Dim data1 as string, data2 as string
data1 = Target.Offset(-4, -11).Value
data2 = Target.Offset(-4, -9).Value
If (Target.Row - 13) Mod 9 = 0 Then Mail_small_Text_Outlook(data1, data2)
End If
End If
End Sub
Я также убрал некоторые из ненужных строк - дополнительные объявления и т. Д. Не были неправильными, но все эти дополнительные шаги можно выполнить просто в одной строке, как показано.Если для каждой девятой строки есть причина разработки, то простой однострочный комментарий может объяснить это будущему сопровождающему кода.
Стандартные комментарии
Всегда. Всегда . Всегда . Всегда .Использование Option Explicit.
Call устарело и на одном этапе было отмечено в документах VBA как устаревшее.Это ненужный беспорядок.
Будьте осторожны с использованием операторов On Error, особенно в тех частях кода, где вы можете контролировать / проверять входные данные и самостоятельно управлять ожидаемыми ошибками.Это может скрыть основные ошибки кодирования, и вы будете часами искать что-то, когда не получите правильных результатов, или, что еще хуже, вы просто примете неправильные результаты, не зная, что произошла ошибка.
Примечание1: Для обработчиков событий важно, чтобы количество и типы параметров совпадали с описанием события.Имена переменных, используемых в сигнатуре обработчика событий (например, Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)), могут быть любыми.
Примечание 2: IDE - интегрированная среда разработки