当单元格和位置是动态的时，将超链接添加到单元格

debugcn 发表于 Dev

蜜雪儿

我有一个子程序，当您在单元格中输入名称时，它会创建一个具有相同名称的新工作表并将其添加到列表中。

Sub AddNewTitle()

Dim DshB As Worksheet, WS As Worksheet
Set DshB = ThisWorkbook.Worksheets("Dashboard")
Set WS = Sheets.Add(after:=Sheets("Data"))

WS.Name = DshB.Range("C2").Value

Dim NewTitle As Range, Header As Range, AyOne As Range
Set NewTitle = DshB.Range("C2")
Set AyOne = WS.Range("A1")
Set Header = WS.Range("A1:L1")

With NewTitle
    DshB.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = .Value 'Name added to list
End With

AyOne = NewTitle
Header.Merge
Header.Font.Size = 15
Header.Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble

NewTitle.ClearContents

End Sub

我想将名称添加到列表时，将其链接到新表。

如何超链接每次都会不同的工作表名称？

CDP1802

Add the link like this

DshB.Hyperlinks.Add _
    Anchor:=cell, _
    Address:="", _
    SubAddress:="'" & NewTitle & "'!A1", _
    TextToDisplay:=NewTitle

这是完整的脚本，其中包含对现有工作表的一些补充检查

Sub AddNewTitle()

    Const TITLE As String = "C2"

    Dim DshB As Worksheet, ws As Worksheet
    Set DshB = ThisWorkbook.Worksheets("Dashboard")

    Dim NewTitle As String
    NewTitle = DshB.Range(TITLE).Value

    'check Not blank
    If Len(NewTitle) = 0 Then
        MsgBox "Empty cell C2", vbCritical
        Exit Sub
    End If

    ' check not existing
    For Each ws In ThisWorkbook.Sheets
        If ws.NAME = NewTitle Then
           MsgBox NewTitle & " is an existing sheet ", vbCritical
           Exit Sub
        End If
    Next

    Set ws = Sheets.Add(after:=Sheets("Data"))
    ws.NAME = NewTitle
    ws.Range("A1").Value = NewTitle
    With ws.Range("A1:L1")
        .Merge
        .Font.Size = 15
        .Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlDouble
    End With

    Dim cell As Range
    Set cell = DshB.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)

    DshB.Hyperlinks.Add _
    Anchor:=cell, _
        Address:="", _
        SubAddress:="'" & NewTitle & "'!A1", _
        TextToDisplay:=NewTitle

    DshB.Range(TITLE).ClearContents
    DshB.Activate

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。