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

我已经看过很多帖子，似乎无法得到此权利。我有一个带有代码名称的用户窗体，然后创建一个具有该名称的工作表，然后将链接添加到新工作表，作为另一工作表B列中的最后一个单元格。我使用了3种不同的方法来插入超链接，但它们都只是返回一个空白单元格，而如果我将值更改为任何字符串，它都可以工作。创建超链接到单元VBA中的工作表

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个空白单元格和（代号名称）作为纯文本，这显示我明显错过了一些容易让我终生难以想象的事情。感谢所有的回应。

来源

2016-06-01 KinggPush

链接不工作的原因可能是因为您使用工作表对象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被盗。

来源

2016-06-01 06:29:38 Vegard

谢谢！这个伎俩！ – KinggPush

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

来源

2016-06-01 06:37:27

如果我明白你的意思，你正在努力做到这一点......但不明白为什么它是“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

来源

2016-06-01 06:57:58 PatricK

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

回答

相关问题