在單元格 VBA 中創建指向工作表的超鏈接

Question

我看了很多帖子，似乎無法做到這一點。 我有一個用戶表單，它采用代號，然后創建一個具有該名稱的工作表，然后添加一個指向新工作表的鏈接作為另一張工作表上 B 列中的最后一個單元格。 我使用了 3 種不同的方法來插入超鏈接，但它們都只返回一個空白單元格，而如果我將值更改為任何字符串，它就可以工作。

    Dim sh As Worksheet
    Dim codename As String
    Dim lastrow As Long
    Dim cont As Worksheet

    On Error Resume Next

    Application.ScreenUpdating = False


    codename = InputBox("What is the codename?")


    Sheets("XXX").Visible = True
    Sheets("XXX").Copy After:=Worksheets("YYY")
    ActiveWindow.ActiveSheet.name = codename
    Sheets("XXX").Visible = False

    Worksheets(YYY).Activate
    lastrow = Sheets("YYY).Range("B" & Rows.Count).End(xlUp).Row + 1

    ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(1).Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:=sh & "!A1", TextToDisplay:=codename
    ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(2).Activate
    ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:="", SubAddress:=sh.name & "!A1", TextToDisplay:=codename
    ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(3) = codename
    ActiveSheet.Range("B" & lastrow).End(xlUp).Offset(4).Hyperlinks.Add Anchor:=Sheets(codename).Cells(1, 1), _
                  Address:="", SubAddress:=sh, TextToDisplay:=codename

    Application.ScreenUpdating = True

我知道我有 4 次基本相同的迭代。 關鍵是，無論我使用其中的 1 個，還是全部 4 個，我都會得到 3 個空白單元格和（代號）作為明文，這表明我顯然錯過了一些我一生無法弄清楚的簡單東西。 感謝所有回復。

Answer 1

鏈接不起作用的原因可能是因為您使用了工作表對象sh而不聲明它，特別是沒有將其聲明為新工作表。

在我的解決方案中，我只使用.Add方法對其進行了測試，該方法包含在注釋中。

Sub test()
    Dim sh As Worksheet, nsh As Worksheet ' sh = YYY, nsh = codename
    Dim nrng As Range
    Dim codename As String
    Dim lastrow As Long
    Dim cont As Worksheet

    codename = InputBox("What is the codename?")

    Set sh = Sheets("YYY")

    Sheets("XXX").Visible = True
    Sheets("XXX").Copy After:=Worksheets("YYY")
    ActiveWindow.ActiveSheet.Name = codename
    Sheets("XXX").Visible = False
    'Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = codename ' if needed

    sh.Activate
    lastrow = sh.Range("B" & Rows.Count).End(xlUp).Row + 1

    sh.Hyperlinks.Add _
        Anchor:=sh.Range("B" & lastrow), _
        Address:="", _
        SubAddress:="'" & codename & "'!A1", _
        TextToDisplay:=codename
End Sub

無恥地從自己身上偷走。

Answer 2

Sub Tester()

    DoHyperlink Sheets("Sheet1").Range("F10"), _
           Sheets("Sheet 2").Range("E12"), _
           "Click Me"

End Sub

'assumes rngFrom and rngTo are in the same workbook...
Sub DoHyperlink(rngFrom As Range, rngTo As Range, LinkText As String)

    rngFrom.Parent.Hyperlinks.Add Anchor:=rngFrom, Address:="", _
            SubAddress:="'" & rngTo.Parent.Name & "'!" & rngTo.Address(), _
            TextToDisplay:=LinkText

End Sub

Answer 3

如果我猜對了，您就是在嘗試這樣做……但不明白為什么它是“YYY”（不是動態的）。

Option Explicit

Sub AddSheetAndLinkIt()
    Dim codename As String
    Dim oWS As Worksheet, oRng As Range

    codename = InputBox("What is the codename?")
    ' Check if codename already exists
    On Error Resume Next
    Set oWS = ThisWorkbook.Worksheets(codename)
    If Not oWS Is Nothing Then
        MsgBox "The worksheet for """ & codename & """ already exists! You cannot create it again.", vbExclamation + vbOKOnly
        Exit Sub
    End If
    ' Copy worksheet "XXX" and add hyperlink to "YYY"
    Set oWS = ThisWorkbook.Worksheets("YYY")
    Set oRng = oWS.Range("B" & Rows.Count).End(xlUp)
    ThisWorkbook.Worksheets("XXX").Copy After:=oWS
    With ThisWorkbook.Worksheets("XXX (2)")
        .Name = codename
        .Visible = True
        .Activate
    End With
    oWS.Hyperlinks.Add oRng, "", "'" & codename & "'!A1", "Go to " & codename, codename
    Set oRng = Nothing
    Set oWS = Nothing
End Sub