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

Question

我正在尝试创建从活动单元到已创建的新工作簿的超链接。在 wb1 中，员工在 sheet2 上输入数据。我有 vba 来选择列 C 中的底部数据，因为这不仅是链接，而且是新 wb 的名称。然后它通过从 wb1 复制 sheet1 创建一个新的 wb。然后它会使用新名称进行另存为。我的麻烦是我似乎无法让超链接地址起作用。如何为超链接引用这个新 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

Answer 1

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

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