используя один код VBA Auto Email, который позволяет дважды щелкнуть две ячейки и отправить по электронной почте разные диапазоны

Question

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

A IS Ссылочный номер, C IS номер детали, G IS номер заказа, N IS проблема с частью, R это их адрес электронной почты, Адрес электронной почты экспедитора,

Теперь я сделал в колонке U ячейки, которые, когда персонал склада удваивается нажмите, появится электронное письмо с адресом в T и темой А, С, G. Тело текста включает подсказку для просмотра электронная таблица.

Я хочу иметь возможность затем сделать столбец X сделать тот же двойной щелчок функция, но вместо того, чтобы по электронной почте то же сообщение, что и при двойном щелкните столбец U, чтобы экспедиторы получили другой адрес (из столбца R) и другой предмет и тело, чтобы сообщить персоналу склада, что у них есть решил проблему.

Я написал код, позволяющий дважды щелкнуть столбец U и ящик электронной почты появится, и он работает потрясающе! Но я застрял на том, как сделать то же самое для столбца X. Я попытался скопировать и вставить оригинал код под собой и изменение параметров в соответствии со столбцом X, но Excel VBA, кажется, рассматривает это, как будто код не был там?

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)

Dim sRef        As String
Dim sMat        As String
Dim sIssue      As String
Dim sMeYou      As String
Dim sTo         As String
Dim sBody       As String
Dim sOrder      As String
Dim sSend       As String
Dim bSucces     As Boolean


On Error GoTo Err_Mail


If Not Intersect(Target, Range("U:U,X:X")) Is Nothing Then
    With Target

        sRef = .Offset(0, -20).Value
        sMat = .Offset(0, -17).Value
        sIssue = .Offset(0, -7).Value
        sMeYou = .Offset(0, -1).Value
        sTo = .Offset(0, -1).Value
        sSend = .offset(0,-3).value
        sOrder = .Offset(0, -14).Value


    End With


    Cancel = True
Else

    Cancel = False
    Exit Sub
End If


If sMeYou = "expediteremail@warehouse.com" Then
    bSucces = CreateMailItem(sTo, "Gareth," & vbNewLine & vbNewLine & "A 
new part has been added to the Plant 2200 Parts Register." & vbNewLine & 
vbNewLine & "Please open up the workbook to review." & vbNewLine & 
vbNewLine & "Issue relates to", sOrder, sIssue, _
    sRef, sMat, 2, False)

ElseIf sMeYou = "expediteremail2@warehouse.com" Then
    bSucces = CreateMailItem(sTo, "Gail," & vbNewLine & vbNewLine & "A 
new part has been added to the Plant 2200 Parts Register." & vbNewLine & 
vbNewLine & "Please open up the workbook to review." & vbNewLine & 
vbNewLine & "Issue relates to", sOrder, sIssue, _
    sRef, sMat, 2, False)

ElseIf sSend = "harrywood@siemens.com" Then
    bSucces = CreateMailItem(sSend, "Team please look at this", sOrder, sIssue, sRef, sMat, 2, False)



End If

If bSucces Then
    Target.Offset(0, 26).Value = Now()
Else
    MsgBox "Please fill in all Part details before sending email"
End If

Exit Sub

Err_Mail:
 MsgBox "Sorry there has been an error, please contact Harry Wood 
(Quality)"
End Sub

Public Function CreateMailItem(sTo As String, _
sBody As String, _
sOrder As String, _
sIssue As String, _
sRef As String, _
sMat As String, _
iImportance As Integer, _
bReceipt As Boolean) As Boolean
Dim oOutlookApp  As Object
Dim oOutlookMail As Object
CreateMailItem = False


On Error Resume Next

Set oOutlookApp = GetObject(, "Outlook.Application")


If Err <> 0 Then

    Set oOutlookApp = CreateObject("Outlook.Application")

End If

If Not oOutlookApp Is Nothing Then
    Set oOutlookMail = oOutlookApp.CreateItem(0)
    If Not oOutlookMail Is Nothing Then
        With oOutlookMail

            .To = sTo

            .Subject = "Ref: " & sRef & "            Part Number: " & 
             sMat & "       Order Number: " & sOrder

            .Body = sBody & vbCr & sIssue

            .Importance = iImportance

            .ReadReceiptRequested = bReceipt

            .Display
            CreateMailItem = True
        End With
    End If
End If


Set oOutlookMail = Nothing
Set oOutlookApp = Nothing
End Function 

снова скопирует этот код и изменит параметры. или мне нужно сделать что-то еще? Теперь я застрял в своих собственных ограничениях знания vba.

Answer 1

Попробуйте изменить:

If Target.Column = 21 Then

Кому:

If Not Intersect(Target, Range("U:U,X:X")) Is Nothing Then