需要创建从活动单元格到新创建的工作簿的超链接
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
我正在尝试创建一个 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