在单元格VBA中创建超链接到工作表

时间:2016-06-01 00:04:28

标签: excel vba excel-vba

我看过很多帖子,似乎无法做到这一点。我有一个带有代号的userform,然后创建一个具有该名称的工作表,然后添加一个指向新工作表的链接作为另一个工作表上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个空白单元格和(代号)作为明文,这表明我显然遗漏了一些容易让我无法理解的生活。感谢所有回复。

3 个答案:

答案 0 :(得分: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

myself无耻地偷走。

答案 1 :(得分:0)

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

答案 2 :(得分:0)

如果我找对你,你就是想这样做......但不明白为什么它是“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