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

我看了很多post,似乎无法得到这个权利。 我有一个用户窗体获取代码名称,然后创build一个具有该名称的工作表,然后将链接添加到新工作表作为另一个工作表上列B中的最后一个单元格。 我已经使用了3种不同的方法来插入超链接,但是他们都只是返回一个空白单元格,而如果我将值更改为任何string,它的工作原理。

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个基本相同的事情迭代。 重要的是,不pipe我用了其中的1个,还是全部4个,我都会得到3个空白单元格和(codename)作为明文,这显示我显然错过了一些容易的事情,我对于我的生活无法想象。 感谢所有的回应。

链接不工作的原因可能是因为您使用工作表对象sh而不声明它,具体而言,没有声明它为新工作表。

在我的解决scheme中,我只使用包含在注释中的.Add方法进行testing。

 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 

无耻地从我自己偷走。

 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 

如果我得到你的权利,你正在试图这样做…但不明白为什么它是“YYY”(不dynamic)。

 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