|
我帮搂主把那个生成目录的函数 改了改 主要是加了注释，另外把变量名规范了一下 功能只是加了一个序号。希望楼主笑纳。 Sub GenTOC()
'生成所有 Sheet 的目录
Dim iCount As Integer
Dim SheetCount As Integer
Dim SelectionCell As Range On Error GoTo gtoc_Error
SheetCount = Worksheets.Count
If SheetCount = 0 Or SheetCount = 1 Then Exit Sub
Application.ScreenUpdating = False
'已经生成目录 Sheet 后的情况 把目录Sheet移动到最前面
'KB Sheets 集合从 1 开始
For iCount = 1 To SheetCount
If Sheets(iCount).Name = "目录" And iCount <> 1 Then
Sheets("目录").Move Before:=Sheets(1)
Exit For
End If
Next iCount
'经过上一轮操作以后 如果第一个Sheet不是 "目录" 可见需要加一个 New Sheet
If Sheets(1).Name <> "目录" Then
Sheets(1).Select
Sheets.Add '默认加到当前选中 Sheet 之前
Sheets(1).Name = "目录" '此时 Sheet(1) 已经是 New Sheet 了
'比 SheetCount = SheetCount + 1 好 明白吗？
SheetCount = Worksheets.Count
End If
Sheets("目录").Select
'Columns("B:B").Delete Shift:=xlToLeft
Application.StatusBar = "正在生成目录,请稍候！"
'生成超链接
For iCount = 2 To SheetCount
Cells(iCount, 1) = Format(iCount - 1)
ActiveSheet.Hyperlinks.Add _
Anchor:=Worksheets("目录").Cells(iCount, 2), _
Address:="", _
SubAddress:="'" & Sheets(iCount).Name & "'!R1C1", _
TextToDisplay:=Sheets(iCount).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 = 35 '此值可以从 ColorTable 中选择
End With
Application.StatusBar = False
Application.ScreenUpdating = True gtoc_Error: End Sub | 
楼主: shuiyuan
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-6-12 14:27
