Office中国论坛/Access中国论坛

标题: （已解决）快速VBA目录 [打印本页]

作者: 冰心8549 时间: 2011-11-14 18:51
标题: （已解决）快速VBA目录
本帖最后由冰心8549 于 2011-11-15 13:06 编辑

快速VBA目录

快速VBA目录请求各位，能不能帮忙自动加序号？

Sub mulu()
On Error GoTo R                '如遇到错误语句将直接挑到R运行
Dim i As Integer                   '定义I,shtcount和SelectionCell变量
Dim ShtCount As Integer
Dim SelectionCell As Range
ShtCount = Worksheets.Count
If ShtCount = 0 Or ShtCount = 1 Then Exit Sub    '工作簿内仅0或1张工作表时候退出
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 '清除B列
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) = "目录"                               'B列第一个单元格录"目录"
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
R:
End Sub
要求：效果
要求：效果2

作者: pureshadow 时间: 2011-11-15 11:41
汗，做个目录要这么复杂的代码，hyperlink就可以搞定了。
=hyperlink("#sheet!"&row(a1),)
提取页码稍麻烦点，有个变通的办法，如果没有缩放的话，可以统计最后一行的位置，再除以每页行数。

作者: 冰心8549 时间: 2011-11-15 13:04

pureshadow 发表于 2011-11-15 11:41
汗，做个目录要这么复杂的代码，hyperlink就可以搞定了。
=hyperlink("#sheet!"&row(a1),)
提取页码稍麻烦 ...

谢谢你的回复，已解决了，稍后我把改好的传上去，

作者: pureshadow 时间: 2011-11-17 22:00
呃……为什么非要用井号……这个，还是问小比去吧。

作者: joyark 时间: 2012-5-6 18:51
謝謝提供學習非常實用

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)