2016-06-01 15 views
2

をハイパーリンクを作成します。私は多くの記事を見ていると、この権利を取得するように見えることはできません。私はその後、別のシート上の列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つの空白のセルと(コードネーム)を取得することです。すべての回答に感謝します。

答えて

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

+0

ありがとう!これはトリックでした! – KinggPush

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 
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 
関連する問題