列出Excel表&图表标签

时间:2014-01-17 03:31:03

标签: excel vba excel-vba

这列出&超链接,所有表格然后所有图表。我希望列表按照工作簿中的顺序排列;例如,sheet1,sheet2,chart1,sheet3,chart2等。我有126个标签,因此不能选择手动重新排序。

我确信有一种方法可以使用IF / OR,但我不知道该怎么做。

Sub CreateLinksToAll()
Dim sh As Worksheet
Dim ch As Chart

Application.ScreenUpdating = False
Sheets("Index").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A2").Select

   For Each sh In ActiveWorkbook.Worksheets
     If ActiveSheet.Name <> sh.Name And sh.Visible Then
       ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
       "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name
       ActiveCell.Offset(1, 0).Select
    End If
   Next sh

   For Each ch In ActiveWorkbook.Charts
     If ActiveSheet.Name <> ch.Name And ch.Visible Then
       ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
       "'" & ch.Name & "'" & "!A1", TextToDisplay:=ch.Name
       ActiveCell.Offset(1, 0).Select
     End If
   Next ch

  Columns("A:A").Font.Size = 12
  Range("A1").Select
End Sub

2 个答案:

答案 0 :(得分:5)

您首先获得所有工作表,然后是图表,因为您正在对每个相应的集合进行两次迭代。

相反,迭代工作簿的.Sheets集合。

从我的原始答案修改:您不需要在此方法中对Sheet / Chart进行任何条件测试。这是未经测试的,但我认为它应该可以工作,如果没有,请告诉我(可能在某处错过了一个括号......)。

Sub Test()

Dim sh As Variant
Dim rng as Range
Dim r as Integer

Application.ScreenUpdating = False
Set rng = Sheets("Index").Range("A2", Range("A2").End(xlDown))
rng.ClearContents
Set rng = rng.Resize(1,1)

For Each sh In ActiveWorkbook.Sheets
   r = r + 1
   rng.Cells(r).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
       "'" & sh.Name & "'" & "!A1", TextToDisplay:=sh.Name

Next
Application.ScreenUpdating = True
End Sub

答案 1 :(得分:2)

  

我希望列表按照工作簿中的顺序排列;即,sheet1,sheet2,chart1,sheet3,chart 2等

为此使用简单的For Loop

For i = 1 To ThisWorkbook.Sheets.Count
    Debug.Print ThisWorkbook.Sheets(i).Name
Next

这里我只是按照它们在工作簿中的顺序显示工作表的名称。只需将您的超链接代码代替即可。

修改

你也可能会发现THIS有趣:)