如何使用自动生成工作簿目录

kevin_zkf

之前看见论坛里有问起。该vba代码可以实现新建一个工作表，自动生成的目录工作表名称为“目录”，然后再a1作出超链接。考虑的比较全面，在此推荐一下。个人比较喜欢以下代码，所以导出bas文件放在我的文档里，附件里有。

Public Sub 目录() '生成工作表目录，生成的目录工作表名称为“目录”，生成前请先确认是否已有同名的工作表
Dim ColStart As Long, RowStart As Long
Dim ws As Worksheet, xlSheet As Worksheet
Dim SheetName As String, SheetExists As Boolean
Dim Msg, Style, Title, Response, MyString
SheetName = "目录"
For Each ws In Worksheets
If ws.Name = SheetName Then
SheetExists = True
Exit For
End If
Next ws
If SheetExists Then
Msg = "目录工作表已存在，是否重生成目录工作表?" ' 定义信息。
Style = vbYesNo + vbInformation + vbDefaultButton1 + vbApplicationModal ' 定义按钮。
Title = Worksheets.Parent.Name ' 定义标题。
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' 用户按下“OK”。
MyString = "Yes"
Set xlSheet = Worksheets(SheetName)
xlSheet.UsedRange.Clear
Else
MyString = "No"
Exit Sub
End If
Else
Set xlSheet = Worksheets.Add(Before:=Worksheets(1), Count:=1, Type:=xlWorksheet)
xlSheet.Name = SheetName
End If
If SheetExists Then
Else
End If
xlSheet.Move Before:=Worksheets(1)
xlSheet.Activate
xlSheet.Cells(1, 1).Value = "目录"
RowStart = 2
ColStart = 1
For Each ws In Worksheets
If ws.Name <> SheetName Then
With xlSheet
.Hyperlinks.Add Anchor:=.Cells(RowStart, ColStart), _
Address:="", _
SubAddress:="'" & ws.Name & "'" & "!A1", _
ScreenTip:=ws.Name, _
TextToDisplay:=ws.Name
RowStart = RowStart + 1
End With
End If
Next ws
End Sub
附： vba自动生成目录.zip (1.07 KB, 下载次数: 254)

2011-4-10 12:04 上传

点击文件名下载附件

mn860429

谢谢分享，下载学习。

tansheng

好东西值得分享

sizuwjh

谢谢分享，下载学习。

leolee82

请问怎么发隐藏帖？

js2468

好好的学习一下

yuanbitao

学习一下，谢谢

哥姐

{:26:}谢谢。。。

mhj

111111111111111111111

sznmbt

支持一下，谢楼主分享