FollowHyperlink事件 - 如何阻止链接打开？ [英] FollowHyperlink event - How to stop link from opening?

问题描述

我有一系列单元格，数据格式如下：

AAA; BBB; CCC

<在理想情况下，我必须为AAA，BBB和CCC中的每一个创建一个单独的超链接。由于Excel允许每个单元格只有一个超链接，我以为我可以拆分单元格文本，并在单击一个虚拟超链接时使用ShellExecute打开三个网页。

I在www.google.com的单元格中创建了超链接，并在FollowHyperlink事件处理程序中编写了以下代码：

  Private Sub Worksheet_FollowHyperlink（ByVal Target As Hyperlink）
 Dim strArray（）As String 
 Dim strSamp As String 
 
 strArray（）= Split（ActiveCell.Text，;） 
 
对于i = LBound（strArray）到UBound（strArray）
 strSamp =www。 + strArray（i）+.com
 lSuccess = ShellExecute（0，打开，strSamp）
 MsgBox（strSamp）
下一步i 
 End Sub 
  

每次点击单元格时，浏览器都会打开Goog​​le，并且不会显示消息框。

我无法确定我的逻辑错误在哪里。我希望你能给我的任何见解。

编辑：

我在一个新的工作表中重写代码，代码正常运行。消息框现在正在显示，各个超链接在浏览器中打开。但是除了个人链接之外，虚拟链接（在这种情况下是Google）也是开放的。我如何阻止它打开？

解决方案

我使用 Worksheet_BeforeDoubleClick 这些操作的事件。

让我们说文本在单元格A1中。尝试这个。

 私有声明函数ShellExecute Libshell32.dll别名ShellExecuteA_ 
（ByVal hwnd As Long，ByVal lpszOp As String，_ 
 ByVal lpszFile As String，ByVal lpszParams As String，_ 
 ByVal LpszDir As String，ByVal FsShowCmd As Long）as Long 
 
 Private Sub Worksheet_BeforeDoubleClick （ByVal Target As Range，Cancel As Boolean）
 Dim strArray（）As String，strSamp As String 
 Dim i As Long 
 
如果不相交（目标，范围（A1 ））Is Nothing Then 
 strArray = Split（Target.Value，;）
 
对于i = LBound（strArray）到UBound（strArray）
 strSamp =www 。 + strArray（i）+.com
 ShellExecute 0，打开，strSamp，，，SW_SHOWNORMAL 
 DoEvents 
下一个i 
取消= $ b结束If 
 End Sub 
  

编辑：哎呀，我忘了提到你需要双击这个代码来运行的单元格 A1 ：p

注意：如果您仍然使用 Worksheet_FollowHyperlink（）方法，则超链接单元格本身而不是一个网站。这不会启动网站并显示您的消息框。

I have a range of cells with data in the form:

"AAA;BBB;CCC"

where ideally I have to create a separate hyperlink for each of AAA, BBB and CCC. Since Excel allows for only one hyperlink per cell, I thought I could split the cell text and open up three webpages using 'ShellExecute' when a dummy hyperlink is clicked.

I created a hyperlink in the cell to "www.google.com" and wrote the following code in the 'FollowHyperlink' event handler:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    Dim strArray() As String
    Dim strSamp As String

    strArray() = Split(ActiveCell.Text, ";")

    For i = LBound(strArray) To UBound(strArray)
       strSamp = "www." + strArray(i) + ".com"
       lSuccess = ShellExecute(0, "Open", strSamp)
       MsgBox (strSamp)
    Next i
End Sub

Every time I click on the cell, the browser opens Google and the Message Boxes are not displayed.

I cannot figure out where I am going wrong in my logic. I would appreciate any insight any of you could give me.

Edit:

I rewrote the code in a fresh worksheet and the code is functioning as it should. The Message Boxes are displaying now and the individual hyperlinks are opening in the browser. But in addition to the individual links, the dummy link (in this case Google) is also opening. How do I stop it from opening?

解决方案

I use the Worksheet_BeforeDoubleClick event for these kind of operations.

Let's say the text is in Cell A1. Try this.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpszOp As String, _
ByVal lpszFile As String, ByVal lpszParams As String, _
ByVal LpszDir As String, ByVal FsShowCmd As Long) As Long

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim strArray() As String, strSamp As String
    Dim i As Long

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        strArray = Split(Target.Value, ";")

        For i = LBound(strArray) To UBound(strArray)
            strSamp = "www." + strArray(i) + ".com"
            ShellExecute 0, "Open", strSamp, "", "", SW_SHOWNORMAL
            DoEvents
        Next i
        Cancel = True
    End If
End Sub

Edit:

Oops, I forgot to mention that you need to double click on cell A1 for this code to run :p

Note: If you want to still use the Worksheet_FollowHyperlink() method then hyperlink the cell to itself and not to a website. This will not launch the website and show your message boxes.

这篇关于FollowHyperlink事件 - 如何阻止链接打开？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！