需要创建从活动单元格到新创建的工作簿的超链接

Need to create a hyperlink from active cell to newly created workbook

我正在尝试创建一个 hyperlink 从 activecell 到创建的新工作簿。在 wb1 中,员工在 sheet2 上输入数据。我有 vba 到 select 列 C 中的底部数据,因为这不仅是 link,而且是新 wb 的名称。然后它通过从 wb1 复制 sheet1 创建一个新的 wb。然后它使用新名称保存。我的问题是我似乎无法使用 hyperlink 地址。我如何为 hyperlink 引用这个新 wb 的地址?我似乎无法理解地址。感谢您的协助。

Sub NewSheet()

Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim FName As String

Set wb1 = ThisWorkbook
Set ws1 = wb1.Sheets("Sheet1")

'Copy Name
wb1.ActiveSheet.Range("C" & Cells.Rows.Count).End(xlUp).Select
wb1.ActiveSheet.Range("C" & Cells.Rows.Count).End(xlUp).Copy

Sheets("Sheet1").Activate
Range("H5").Activate
Range("H5").PasteSpecial

'Path for saving file
Path = "C:\Excel Testing\"
'Filename
FName = ws1.Range("H5")

'Workbook created
Sheets("Sheet1").Copy

Set wb2 = ActiveWorkbook

'Saving workbook with new name
Application.DisplayAlerts = False
wb2.SaveAs filename:=Path & FName, FileFormat:=52
Application.DisplayAlerts = True
    
'Hyperlink cell
Workbooks("Workbook1.xlsm").Activate
Sheets("Sheet2").Select

wb1.ActiveSheet.Range("C" & Cells.Rows.Count).End(xlUp).Select

'I put Path for address for placeholder for question
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Path, SubAddress:=
    "Sheet1!", TextToDisplay:=""



End Sub


我希望超链接现在是您所期望的。由于您是新贡献者,我清理了您的一些代码。希望你不要介意!欢迎。

Sub NewSheet2()
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim ws1 As Worksheet
        
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Sheet1")

    ' Path for saving file
    Dim Path As String: Path = "C:\users\xptp183\Excel Testing\"
        
    ' Filename
    Dim FName As String
    FName = wb1.ActiveSheet.Range("C" & Cells.Rows.Count).End(xlUp).Value
       
     'Workbook created
    Sheets("Sheet1").Copy
    Set wb2 = ActiveWorkbook
    
    'Saving workbook with new name
    Application.DisplayAlerts = False
    wb2.SaveAs Filename:=Path & FName, FileFormat:=52
    Application.DisplayAlerts = True
    
    ' Hyperlink cell
    wb1.Activate
    Sheets("Sheet2").Select
    
    wb1.ActiveSheet.Range("d" & Cells.Rows.Count).End(xlUp).Select
    
    'I put Path for address for placeholder for question
    Dim lnkAddress As String: lnkAddress = Path & FName & ".xlsm"
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=lnkAddress, TextToDisplay:=""
    
End Sub