請幫忙(自動生成實用工作表目錄)

joyark

請幫忙(生成實用工作表目錄)

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

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

liuhoubin168

=IF(B12<>"",A11+1,"")，然后一直向下填充。

joyark

是用vba自動生成

老鬼

以下代码可自动设序号：   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

幫忙修改按下自動生成目錄

老鬼

试一下下面的代码：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