每当添加新工作表时,在Excel中创建到工作表的超链接

时间:2018-09-27 13:14:37

标签: excel vba hyperlink

我想知道Excel中是否有一个选项可以让您在第一张工作表中创建超链接(我们称其为主工作表),一旦创建其他任何工作表即可。因此,一旦我创建了一个新表,指向它的超链接就会出现在主表中。

2 个答案:

答案 0 :(得分:1)

  • 右键单击要链接的单元格,然后单击Link

  • 这将打开插入超链接对话框。

  • 在左侧,单击Place in this document

  • 选择工作表并输入单元格名称。

img

您可以使用the Hyperlinks.Add method以编程方式执行此操作。

您可以使用工作簿模块的NewSheet事件将链接自动添加到新工作表或从新工作表添加链接。

还可以添加到外部工作簿的链接,包括在线发布的那些。


下面是一个粗略的示例代码,您可以在每次创建新工作表时在“主”工作表上创建链接:

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim shtName As String, ws As Worksheet, rg As Range
    shtName = InputBox("Enter name for new worksheet:")
    Sh.Name = shtName
    Set ws = Sheets("main")
    Set rg = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    rg = shtName
    ws.Hyperlinks.Add rg, "", shtName & "!A1", , shtName
End Sub

更多信息:

答案 1 :(得分:1)

创建工作表菜单

Option Explicit
Sub WsMenu()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'Writes a list of hyperlinks and various other properties of all sheets in a
  'workbook to a specified worksheet which is not included in the list.
'Preconditions
  'There has to be a worksheet called cStrName in the workbook, which will
  'become the 'Menu' or what ever you wanna call it.
'Arguments as constants
  'cStrName
    'Name of the 'Menu' worksheet.
  'cStrAddress
    'The address on each sheet where the hyperlink will jump to.
  'clRoff
    'If you don't want to start the list in the first row.
  'ciCoff
    'If you don't want to start the list in column "A".

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Const cStrName As String = "Menu"
  Const cStrAddress As String = "A1"
  Const clROff As Long = 0 'Row Offset
  Const ciCOff As Integer = 0 'Column Offset

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim oWsMenu As Worksheet
  Dim iSheets As Integer
  Dim strName As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set oWb = ThisWorkbook
  Set oWsMenu = oWb.Worksheets(cStrName)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  With oWsMenu
    'Header
    'Clear the previous data (includes the formatting), or rather use
    'ClearContents to preserve the formatting.
    .Cells.Clear

    .Cells(1 + clROff, 1 + ciCOff) = "RID" 'RecordId
    .Cells(1 + clROff, 2 + ciCOff) = "Name"
    .Cells(1 + clROff, 3 + ciCOff) = "CodeName"
    .Cells(1 + clROff, 4 + ciCOff) = "Index" 'The postion of the oWs in oWb
    .Cells(1 + clROff, 5 + ciCOff) = "H" 'Number of Hyperlinks in oWs
    .Cells(1 + clROff, 6 + ciCOff) = "Used Range"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Calculate and write to 'Menu'
    For Each oWs In oWb.Worksheets

      'You don't want the "Menu" worksheet to appear in the list.
      If oWs.Name <> cStrName Then

        iSheets = iSheets + 1
        .Cells(iSheets + clROff + 1, 1 + ciCOff) = iSheets

        'The Hyperlink
        .Cells(iSheets + clROff + 1, 2 + ciCOff).Hyperlinks.Add _
          Anchor:=.Cells(iSheets + clROff + 1, 2 + ciCOff), _
          Address:="", _
          SubAddress:="'" & oWs.Name & "'!" & cStrAddress, _
          TextToDisplay:=oWs.Name
        'Notice the single quotes (') in the SubAddress.

        .Cells(iSheets + clROff + 1, 3 + ciCOff) = oWs.CodeName
        .Cells(iSheets + clROff + 1, 4 + ciCOff) = oWs.Index
        .Cells(iSheets + clROff + 1, 5 + ciCOff) = oWs.Hyperlinks.Count
        .Cells(iSheets + clROff + 1, 6 + ciCOff) = oWs.UsedRange.Address
      End If
    Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'This is a work around, a lousy one.
    If .Name <> ActiveSheet.Name Then
      .Activate
    End If

    'The following line does a 1004 without the previous 3 lines, only when
    'calling the program from a sheet different then 'Menu'. I have no idea why!?

    'Apply some additional formatting.
    With .Range(Cells(1 + clROff, 1 + ciCOff), Cells(1 + clROff, 6 + ciCOff))
      .AutoFilter
      .Columns.AutoFit
    End With

  End With
End Sub

另外转到工作表事件并添加以下内容:

Private Sub Worksheet_Activate()
  WsMenu
End Sub