列出带有链接的所有单页 [英] List all sheets with link

问题描述

如何自动创建所有页面的索引，我有很多客户，每个客户都有一张表。

How can create a index for all sheets automatically, I have a lot customers, with a sheet for each customer.

我还想显示一些数据在所有表格的索引中。

I also want to show some of the data in index of all the sheets.

查看图片

see images

推荐答案

循环遍历为每个创建一个链接的工作表。这将从活动单元格开始列出。

Loop through the sheets creating a link for each. This will list them starting at the active cell.

Sub CreateLinksToAllSheets()
Dim sh As Worksheet
Dim cell As Range
Dim strLink As String

For Each sh In ActiveWorkbook.Worksheets

    If ActiveSheet.name <> sh.name Then

        strLink = sh2.name
        If InStr(strLink, "'") Then
            strLink = Replace(strLink, "'", "''")
        End If

        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & strLink & "'" & "!A1", TextToDisplay:=sh.name

        ' Here you can get the amount and mobile and write them to the adjacent columns.
        ActiveCell.Offset(0, 1).Value = Excel.worksheetFunction.Sum(sh.Range("A:A"))
        ActiveCell.Offset(0, 2).Value = sh.Range("G1").Value

        ActiveCell.Offset(1, 0).Select

    End If

Next sh

End Sub

如果你想硬链接去，你可以这样做。

If you want to hard code where the links go you can do it like this.

Sub CreateLinksToAllSheets()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim cell As Range
Dim lRow As Long

    Set sh = ActiveWorkbook.Sheets("Sheet1")
    lRow = 1

    For Each sh2 In ActiveWorkbook.Worksheets

        If ActiveSheet.name <> sh2.name AND sh2.name <> "new customer" AND sh2.name <> "old archive" Then

            strLink = sh2.name
            If InStr(strLink, "'") Then
                strLink = Replace(strLink, "'", "''")
            End If

            sh.Hyperlinks.Add Anchor:=sh.Range("A" & lrow), Address:="", SubAddress:="'" & strLink & "'" & "!A1", TextToDisplay:=sh2.name
            sh.Range("B" & lRow).Value = Excel.worksheetFunction.Sum(sh2.Range("A:A"))
            sh.Range("C" & lRow).Value = sh2.Range("G1").Value

            lRow = lRow + 1

        End If

    Next sh2

End Sub

编辑： OP请求

如何使列B和C值中的值从表格中更新？示例：列B：= SUMMA（Customer1！A：A）列C：= Customer1！G1

OP asks
How can I make the value in column B and C Value be renewed from within sheets? Example: Column B: =SUMMA(Customer1!A:A) Column C: =Customer1!G1

可以使用公式属性。使用sh2.Name插入当前sh2工作表中的工作表名称。

You can use the formula property. Insert the sheet name from the current sh2 worksheet by using sh2.Name.

 sh.Range("B" & lRow).Formula = "=SUM(" & sh2.Name & "!A:A)"
 sh.Range("C" & lRow).Formula = "=" & sh2.Name & "!G1"

编辑： OP发现创建一个超链接在该名称中具有撇号的工作表不会创建正常的链接。

OP found that creating a hyperlink to a sheet that has an apostrophe in the name does not create a functioning link.

要解决这个问题，我们可以在工作表名称中添加一个撇号的检查。如果我们找到一个，我们将用两个撇号替换它。

To fix this we can add a check for the existence of an apostrophe in the sheet name. If we find one we will replace it with two apostrophes.

strLink = sh2.name
If InStr(strLink, "'") Then
     strLink = Replace(strLink, "'", "''")
End If

并更改hyperlinks.add以创建SubAddress：='& strLink&

And change the hyperlinks.add to create SubAddress:="'" & strLink & "'"

sh.Hyperlinks.Add Anchor:=sh.Range("A" & lrow), Address:="", SubAddress:="'" & strLink & "'" & "!A1", TextToDisplay:=sh2.name

这篇关于列出带有链接的所有单页的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！