超链接或按钮,用于运行具有活动单元格偏移的宏

时间:2017-12-14 14:04:24

标签: excel-vba hyperlink lotus-notes vba excel

我正在寻找一种轻松发送电子邮件的方法。我有一个excel文件,我每天添加大约20行的客户编号和订单号。也是一个电子邮件地址,不同的主题和机构取决于国家。 我使用Lotus Notes并将所有代码设置为发送和附加文件。我发送电子邮件的宏使用活动单元格上的偏移量。所以目前,我点击某个单元格,然后按一个键绑定发送电子邮件。

但是,我想更改它,以便人们可以单击每行上的超链接或按钮来创建电子邮件。我尝试使用表单和activex控件中的按钮,但这使我的文件太慢了。

然后我研究了一种在单击超链接时激活宏的方法。

我在互联网上找到了这个。

    Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Select Case Target.Range.Address
    Case "$B$3"
    Call myMacro
    Case Else
    End Select
    End Sub

但这仅适用于单元格B3中的链接。如何点击B列中的任何链接,宏将运行?

如果还有其他解决方案,请随时告诉我。

亲切的问候,

EDIT1:

这是电子邮件的代码

Sub myMacro(Target As Range)
'Send an e-mail & attachment using Lotus Not(s)
'Original Code by Nate Oliver (NateO)
'Declare Variables for file and macro setup
Dim UserName As String, MailDbName As String, Recipient As String, ccRecipient As String, Attachment1 As String
Dim Maildb As Object, MailDoc As Object, AttachME As Object, Session As Object
Dim EmbedObj1 As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If

Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"
Recipient = Target.Offset(0, 1).Value
MailDoc.SendTo = Recipient
ccRecipient = Target.Offset(0, 2).Value
MailDoc.CopyTo = ccRecipient
MailDoc.Subject = Target.Offset(0, 3).Value
MailDoc.Body = Target.Offset(0, 4).Value

Dim Orderno
Dim myPath
Dim myFile

Orderno = Target.Offset(0, 5).Value
myPath = ThisWorkbook.Path & "D:\Berry\Order Confirmations\VBAtest\"
myFile = Dir(myPath & "*" & Orderno & "*.pdf*")
Attachment1 = (myPath & myFile)
MsgBox (Attachment1)
If Attachment1 <> "" Then
On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "attachment1", (myPath & myFile), "")
On Error Resume Next
End If

Set workspace = CreateObject("Notes.NotesUIWorkspace")
Call workspace.EDITDOCUMENT(True, MailDoc).GOTOFIELD("Body")

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing

1 个答案:

答案 0 :(得分:2)

要在单击B列上的任何内容时运行宏:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Select Case Target.Range.Column
    Case 2 'Two being the column number
        Call myMacro
    Case Else
End Select
End Sub

当您使用Offset获取电子邮件的值时,您将偏移目标以获得正确的值,因此如果您要传递一个参数,或者像你的那样:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Select Case Target.Range.Column
    Case 2 'Two being the column number
        Call myMacro(Target.Range)
    Case Else
End Select
End Sub

然后在您的宏中,您可以执行以下操作:

Sub myMacro(Target as Range)
    Target.offset(0,1).value 'to get the value to the right of the clicked cell    
.....

End sub
相关问题