我已經為一個單元格分配了一個宏，所以當它被單擊時，它會復制一個模板表，詢問您想要的名稱，然后將該名稱添加到列中的下一個空白單元格中。
我在下面嘗試過，它沒有錯誤，但它也沒有超鏈接。
我現在如何使名稱所在的單元格超鏈接到該作業表？主作業表上的完整 vba：
Public Sub CopySheetAndRenameByCell()
Dim newName As String
Dim Emrange As Range
Set Emrange = Application.Range("C" & Rows.Count).End(xlUp).Offset(1)
On Error Resume Next
newName = InputBox("Enter the name of the new project", "Copy worksheet", ActiveCell.Value)
If newName <> "" Then
Sheets("Project Sheet BLANK").Copy After:=Worksheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = newName
Emrange.Value = newName
Worksheets(newName).Select
Emrange.Select
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="newName!A1", TextToDisplay:="New sheet"
End If
End Sub
uj5u.com熱心網友回復：
像這樣：
Public Sub CopySheetAndRenameByCell()
Dim newName As String, Emrange As Range, wsNew As Worksheet, wb As Workbook
Dim wsIndex As Worksheet
newName = InputBox("Enter the name of the new project", _
"Copy worksheet", ActiveCell.Value)
If newName <> "" Then
Set wb = ThisWorkbook
wb.Worksheets("Project Sheet BLANK").Copy _
After:=wb.Worksheets(wb.Worksheets.Count)
Set wsNew = wb.Worksheets(wb.Worksheets.Count)
On Error Resume Next 'ignore error on rename
wsNew.Name = newName
On Error GoTo 0 'stop ignoring errors
Set wsIndex = wb.Worksheets("Index") 'for example
Set Emrange = wsIndex.Range("C" & Rows.Count).End(xlUp).Offset(1)
wsIndex.Hyperlinks.Add Anchor:=Emrange, _
Address:="", SubAddress:="'" & wsNew.Name & "'!A1", _
TextToDisplay:=wsNew.Name
'reset font style
Emrange.Font.Underline = xlUnderlineStyleNone
Emrange.Font.ColorIndex = xlAutomatic
If wsNew.Name <> newName Then 'in case sheet could not be renamed....
MsgBox "Name provided '" & newName & _
"' is not valid as a worksheet name!", vbExclamation
End If
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qiye/528685.html
標籤：擅长vba超链接