在用EXCEL 管理东西时,由于EXCE没有像WORD那种的插入目录的功能,
所以管理的SHEET多的时候,快速定位,就会非常麻烦。
当你遇到这种烦恼时,下面的代码就能帮上忙了,可以帮你自动生成目录~
代码:
Sub mulu()
On Error GoTo Tuichu
Dim i As Integer
Dim ShtCount As
Integer
Dim SelectionCell As Range
ShtCount = Worksheets.Count
If
ShtCount = 0 Or ShtCount = 1 Then Exit Sub
Application.ScreenUpdating = False
For i = 1 To
ShtCount
If Sheets(i).Name = "目录"
Then
Sheets("目录").Move
Before:=Sheets(1)
End
If
Next i
If Sheets(1).Name <>
"目录" Then
ShtCount = ShtCount +
1
Sheets(1).Select
Sheets.Add
Sheets(1).Name =
"目录"
End If
Sheets("目录").Select
Columns("B:B").Delete
Shift:=xlToLeft
Application.StatusBar =
"正在生成目录…………请等待!"
For i = 2 To
ShtCount
ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="",
SubAddress:=
_
"'" & Sheets(i).Name & "'!R1C1",
TextToDisplay:=Sheets(i).Name
Next
Sheets("目录").Select
Columns("B:B").AutoFit
Cells(1, 2) =
"目录"
Set SelectionCell =
Worksheets("目录").Range("B1")
With
SelectionCell
.HorizontalAlignment
= xlDistributed
.VerticalAlignment
= xlCenter
.AddIndent =
True
.Font.Bold =
True
.Interior.ColorIndex =
34
End With
Application.StatusBar =
False
Application.ScreenUpdating = True
Tuichu:
End
Sub
操作方法:
第一个SHEET的名字改为:目录
点击:Alt+F11--->插入--------模块--------把上面的代码拷贝到模块中
然后再运行就可以了。
注:如果点击生成的链接 提示引用无效时。
把下面代码里的 中文下的单引号,改为英文下的单引号。
ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2),
Address:="", SubAddress:=
_
"'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
文章来源:新浪博客