Excel宏：多工作表自动生成链接目录

最近写一个程序，自动从某一软件数据库取出入库数据，按仓库各自保存成一个excel文件，每个excel文件里每个货号独自一个工作表。

为了查看方便，客户要求自动生成一个目录页，网上搜索到了一个宏，代码是这样：

 1 Sub mulu()
 2 On Error GoTo Tuichu
 3 Dim i As Integer
 4 Dim ShtCount As Integer
 5 Dim SelectionCell As Range
 6 
 7 ShtCount = Worksheets.Count
 8 If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
 9 Application.ScreenUpdating = False
10 For i = 1 To ShtCount
11 If Sheets(i).Name = "目录" Then
12 Sheets("目录").Move Before:=Sheets(1)
13 End If
14 Next i
15 If Sheets(1).Name <> "目录" Then
16 ShtCount = ShtCount + 1
17 Sheets(1).Select
18 Sheets.Add
19 Sheets(1).Name = "目录"
20 End If
21 Sheets("目录").Select
22 Columns("B:B").Delete Shift:=xlToLeft
23 Application.StatusBar = "正在生成目录…………请等待！"
24 For i = 2 To ShtCount
25 ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
26 "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name
27 Next
28 Sheets("目录").Select
29 Columns("B:B").AutoFit
30 Cells(1, 2) = "目录"
31 Set SelectionCell = Worksheets("目录").Range("B1")
32 With SelectionCell
33 .HorizontalAlignment = xlDistributed
34 .VerticalAlignment = xlCenter
35 .AddIndent = True
36 .Font.Bold = True
37 .Interior.ColorIndex = 34
38 End With
39 Application.StatusBar = False
40 Application.ScreenUpdating = True
41 Tuichu:
42 End Sub
43 
44 
45 

但是上面宏有一个问题，碰到类似9101-1的货号就会生成日期格式，诸如JAN-1之类，转换单元格格式也不行。后来改了一下就行了

 1 Sub mulu()
 2 On Error GoTo Tuichu
 3 Dim i As Integer
 4 Dim ShtCount As Integer
 5 Dim SelectionCell As Range
 6 
 7 ShtCount = Worksheets.Count
 8 If ShtCount = 0 Or ShtCount = 1 Then Exit Sub
 9 Application.ScreenUpdating = False
10 For i = 1 To ShtCount
11 If Sheets(i).Name = "目录" Then
12 Sheets("目录").Move Before:=Sheets(1)
13 End If
14 Next i
15 If Sheets(1).Name <> "目录" Then
16 ShtCount = ShtCount + 1
17 Sheets(1).Select
18 Sheets.Add
19 Sheets(1).Name = "目录"
20 End If
21 Sheets("目录").Select
22 Columns("B:B").Delete Shift:=xlToLeft
23 Application.StatusBar = "正在生成目录…………请等待！"
24 For i = 2 To ShtCount
25 ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _
26 "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:="'" & Sheets(i).Name
27 Next
28 Sheets("目录").Select
29 Columns("B:B").AutoFit
30 Cells(1, 2) = "目录"
31 Set SelectionCell = Worksheets("目录").Range("B1")
32 With SelectionCell
33 .HorizontalAlignment = xlDistributed
34 .VerticalAlignment = xlCenter
35 .AddIndent = True
36 .Font.Bold = True
37 .Interior.ColorIndex = 34
38 End With
39 Application.StatusBar = False
40 Application.ScreenUpdating = True
41 Tuichu:
42 End Sub
43 
44 
45 

就是这一句不一样：TextToDisplay:="'" & Sheets(i).Name