Office中国论坛/Access中国论坛

标题: 請幫忙(自動生成實用工作表目錄) [打印本页]

作者: joyark 时间: 2005-2-20 11:27
标题: 請幫忙(自動生成實用工作表目錄)
請幫忙(生成實用工作表目錄)

Rem 生成目录

' 2001.6.4.(一)pm10:24

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 = 2 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

[attach]9017[/attach]

[此贴子已经被作者于2005-2-20 12:22:49编辑过]

作者: liuhoubin168 时间: 2005-2-20 11:47
=IF(B12<>"",A11+1,"")，然后一直向下填充。

作者: joyark 时间: 2005-2-20 11:54
是用vba自動生成

作者: 老鬼 时间: 2005-2-20 23:15
以下代码可自动设序号： For i = 2 To ShtCount    cell(i,1).value=i-1

   ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i, 2), Address:="", SubAddress:= _

   "'" & Sheets(i).Name & "'!R1C1", TextToDisplay:=Sheets(i).Name

Next想得到特定工作表的页数，请参考以下贴子：http://www.office-cn.net/forum.php?mod=viewthread&tid=24456

作者: joyark 时间: 2005-2-20 23:57
标题: 幫忙修改
幫忙修改按下自動生成目錄[attach]9019[/attach]

作者: 老鬼 时间: 2005-2-21 05:44
试一下下面的代码：Sub mulu()

i = 1

For Each sh In Sheets

If sh.Name <> "目录" Then

      Cells(i + 1, 1).Value = i                '序号

      ActiveSheet.Hyperlinks.Add Anchor:=Worksheets("目录").Cells(i + 1, 2), Address:="", SubAddress:= _

      "'" & sh.Name & "'!R1C1", TextToDisplay:=sh.Name

      Cells(i + 1, 3).Value = sh.HPageBreaks.Count + 1             '页码

      i = i + 1

End If

Next

End Sub

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