創建超鏈接到單元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中的工作表

回答

相關問題