Создайте новый лист и создайте гиперссылку на лист в сводном листе.

Question

Я разработал код для копирования листа и переименования имени листа со значением, указанным в поле для вставки, а затем скопируйте то же значение в сводный лист и выберите последнюю ячейку и вставьте значение, но я хочу создать гиперссылка, так что, если я нажму на это значение, я попаду на этот лист.

Я застрял в предоставлении правильного субадреса.

Private Sub CommandButton1_Click()
    Dim sName As String
    Dim oRng As Range

    sName = InputBox("New Shipment", "New AWB Number", "Enter the AWB Number")

    If sName <> "" Then
        ThisWorkbook.Sheets("Templete").Copy Before:=Sheets(3)  
        ActiveSheet.Name = sName
        MsgBox "New AWB Number Tracking Added"
    Else
        MsgBox "Failed"  
    End If

    Sheets("Summary").Select
    Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Activate

    ActiveCell.Value = sName
    'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'Sheet(3)'!A1"
End Sub

Когда я запускаю это, я получаю сообщение об ошибке:

"Ссылка не действительна"

Пожалуйста, помогите.

Answer 1

Вы всегда можете столкнуться с проблемами при использовании Select и Activate, но я подозреваю, что вашей основной проблемой был субадрес гиперссылки.Вы пытаетесь установить его на 'Sheet(3)'!A1", который Excel не распознает, поскольку это позиция листа (которую распознает VBA), а не имя листа.Взгляните на ниже

Private Sub CommandButton1_Click()
    Dim sName As String
    Dim oRng As Range
    Dim nWs As Worksheet

    sName = InputBox("New Shipment", "New AWB Number", "Enter the AWB Number")

    If sName <> "" Then
        With ThisWorkbook
            .Sheets("Templete").Copy Before:=.Sheets(3)
            Set nWs = .Sheets(3)
        End With
        nWs.Name = sName

        With Sheets("Summary")
            With .Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
                .Value2 = sName
                .Parent.Hyperlinks.Add Anchor:=.Cells, Address:="", SubAddress:= _
                                        "'" & nWs.Name & "'!A1"
            End With
        End With

        MsgBox "New AWB Number Tracking Added"
    Else
        MsgBox "Failed"
    End If
End Sub

Возможно, вам также следует добавить к этому проверку, чтобы проверить на существующих листах дубликаты или недействительные имена, введенные пользователем.