Excel VBA用于在单元格中呈现超链接

Question

I would like to write my own macro / function in VBA for Excel that introduces a new "formula" JIRA(ISSUE_ID) in Excel so that I can use

=JIRA("ISSUE_ID")

in a cell and it renders the following link (pseudo Markdown syntax)

[ISSUE_ID](http://my.jira.com/browse/ISSUE_ID)

in the very same cell, where [ISSUE_ID] is the link text to be shown in the cell and (http://my.jira.com/tracker/ISSUE) is the URL for the link.

Here is an example that hopefully clarifies my needs:

I use the "formula" =JIRA("ABC-1234") and what my VBA function should do, is rendering a hyperlink into the very same cell that holds this formula which shows ABC-1234 as the content of the cell which is a hyperlink to http://my.jira.com/browse/ABC-1234 .

In VBA pseudo-code, my function writes like this:

Function JIRA(issue_id)
    current_cell = cell_in_which_this_function_is_used_as_formula()
    url = "http://my.jira.com/browse/" + issue_id
    current_cell.content = issue_id     'text to be shown in the cell
    current_cell.hyperlink = url        'hyperlink to be used for the cell
End Function

I can achieve the same result with =HYPERLINK("http://my.jira.com/browse/ISSUE", "ISSUE") but I don't want to write this lengthy function every time. I also don't want to use 2 columns to achieve this (eg =Hyperlink("http://my.jira.com/" & B1,B1) ).

Answer 1

I'm not sure this is possible. You could just write a subroutine to the worksheet change event to automatically add =HYPERLINK("http://my.jira.com/TRACKER/ISSUE", "ISSUE") where you need it whenever cells are updated in the columns holding TRACKER and ISSUE. You could simply build the formula off of the text entered into the cells.

Or, you could do this:

=Hyperlink("http://my.jira.com/" & A1 & "/" & B1,B1)

Assuming that your Tracker column is in column A and your Issue column is in column B. Drag and drop the formula and it will self adjust.

Answer 2

Actually, there is a way. In ThisWorkbook:

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    On Error Resume Next

    If Target.Cells.Count = 1 Then
        Dim cell As Range
        Set cell = Target.Cells(1, 1)
        If LCase(Left(cell.formula, 5)) = "=jira" Then
            If cell.Hyperlinks.Count > 0 Then
                cell.Hyperlinks.Delete
            End If
            Dim issue As String
            issue = Evaluate(cell.formula)
            cell.Hyperlinks.Add cell, _
                                "http://my.jira.com/browse/" & issue, _
                                issue, _
                                "Click to view issue " & issue
        End If
    End If

End Sub

and in a module

Public Function Jira(id As String)
    Jira = id
End Function

Answer 3

Here you can just put the value Issue001 (or whatever the issue is) inside the cell and run this code

Sub setTheHyperLink()
    Dim lastPart
    Dim theScreenTip
    Dim i
    Dim rngList As Range
    Dim theLink

    Set rngList = Selection 'set the range where you have the "Issue"

For Each i In rngList
    lastPart = i.Value
    theScreenTip = lastPart
    theLink = "http://my.jira.com/TRACKER/" & theScreenTip

    If i.Hyperlinks.Count > 0 Then
        i.Hyperlinks(1).Address = theLink
        i.Hyperlinks(1).ScreenTip = theScreenTip
        i.Hyperlinks(1).TextToDisplay = theScreenTip
    Else
        i.Hyperlinks.Add _
        Anchor:=i, _
        Address:=theLink, _
        ScreenTip:=theScreenTip, _
        TextToDisplay:=theScreenTip
    End If
Next i

With that cell defined, you don't need the UDF with this.