在Excel中分离命令按钮和VBA代码

Question

我有一个包含超过100行数据的Excel工作表。当用户完成填写行中的信息时，行末尾有一个命令按钮，该按钮会自动将电子邮件发送到包含该行信息的特定电子邮件帐户。

我已经插入了几个带VB代码的命令按钮来发送电子邮件，效果很好！我遇到的问题是我无法分离命令按钮，即每个按钮的代码应该特定于它所在的行;当我使用包含该命令按钮信息的单元格位置更改代码时，它会将所有命令按钮更改为该信息。

我知道答案必须非常简单，但我已经画了一个完整的空白。我很感激任何帮助！

这是我的代码：

Option Explicit

Private Sub CommandButton2_Click()

On Error GoTo ErrHandler

    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")

    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)

    With objEmail
        .to = "[email address].com"
        .Subject = Range("A3")
        .Body = "[Message]"
        .Send        ' SEND THE MESSAGE.
    End With

    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing

ErrHandler:
    '
End Sub

每一行都应该有相同的命令，只有CommandButton编号改变，而.Subject = Range条目改变。

我做错了，但因为那不起作用。

Answer 1

我在评论中说，简单地将单元格颜色看起来像按钮并让用户点击单元格来发送电子邮件可能更容易 - 然后你可以简单地使用特定行的偏移量，但如果你坚持使用命令按钮，非常简单。

获取当前代码并将其放入接受范围参数的新子例程中。

然后，添加按钮，并将每个按钮链接到具有不同范围的自己的代码。

Option Explicit

Private Sub CommandButton3_Click()
SendEmail Range("A3")
End Sub

Private Sub CommandButton4_Click()
SendEmail Range("A4")
End Sub    

Private Sub CommandButton5_Click()
SendEmail Range("A5")
End Sub

`...

Sub SendEmail(TheRange as Range)
    On Error GoTo ErrHandler
    ' SET Outlook APPLICATION OBJECT.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    ' CREATE EMAIL OBJECT.
    Dim objEmail As Object
    Set objEmail = objOutlook.CreateItem(olMailItem)
    With objEmail
        .to = "[email address].com"
        .Subject = TheRange 'Change this line
        .Body = "[Message]"
        .Send        ' SEND THE MESSAGE.
    End With
    ' CLEAR.
    Set objEmail = Nothing:    Set objOutlook = Nothing
ErrHandler:
End Sub

如果您更喜欢使用SelectionChanged事件，则可以这样做。

然后，如果您想再添加“按钮”

，则可以更新[C4:C8]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, [C4:C8]) Is Nothing Then
    SendEmail Range("A" & Target.Row)
    'Optionally select the subject we sent so we can re-click
    'You can choose any other cell not in our event range
    Range("A" & Target.Row).Select
End If
End Sub