셀 VBA의 시트에 하이퍼 링크 만들기

Question

많은 게시물을 보았으므로이 권한을 얻을 수 없습니다. 코드 네임을 취한 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 가지 반복을 가지고 있음을 알고있다. 요점은 내가 그 중 하나를 사용하든 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 

뻔뻔스럽게도 myself에서 도난당했습니다. 내가 바로 당신을 얻을 경우, 당신은이 작업을 수행하려고 ...하지만 "YYY"(동적되지 않음) 왜 이해하지

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

.

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