下面代码不正确,请高手指正代码!

hcy1185

happym8888 发表于 2012-3-10 15:03

谢谢happym8888老师!
Sub 生成工作表目录()
    With Sheet1
    Dim j As Long
    j = .UsedRange.SpecialCells(xlLastCell).Column + 1 '.Range("iv1").End(xlToLeft).Column + 1
        .Columns(j).Clear
        .Cells(1, j) = "工作表目录"
        m = 0
        For i = 1 To Sheets.Count
            If Sheets(i).CodeName <> Sheets(1).CodeName Then
                m = m + 1
                .Hyperlinks.Add Anchor:=.Cells(m + 1, j), Address:="", SubAddress:= _
                Sheets(i).Name & "!A1", TextToDisplay:=Sheets(i).Name
            End If
        Next i
        .Cells(2, j).Select  '活动工作表不在sheet1时,提示range对于Select方法无效
    End With
End Sub

happym8888

hcy1185 发表于 2012-3-10 16:15
谢谢happym8888老师!
Sub 生成工作表目录()
    With Sheet1

什么意思啊？？？？？

无聊的疯子

hcy1185 发表于 2012-3-10 16:15
谢谢happym8888老师!
Sub 生成工作表目录()
    With Sheet1

纯事件打造,打开工作薄自动自成
添加删除工作表时,需要关闭工作薄重新打开,
也可以将 刷新目录 添加到模块中,然后设置快捷键来操作,
添加到 模块1 中,
则 open 事件中的  Call 刷新目录   应改为 Call 模块1.刷新目录

1. 
   
2. Dim Lx As Byte
   
3. Private Sub Workbook_Open()
   
4.   Call 刷新目录
   
5. End Sub
   
6. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
7. With Target
   
8.     If .Count > 1 Then Exit Sub
   
9.     If .Row = 1 Then Exit Sub
   
10.     Lx = Sh.Range("IV1").End(xlToLeft).Column
    
11.     If .Row > Sh.Cells(1, Lx).End(xlDown).Row Then Exit Sub
    
12.     If Not Sh.Cells(1, Lx).Value Like "工作表目录" Then Exit Sub
    
13.     If .Column = Lx Then Sheets(.Value).Select
    
14.   End With
    
15. End Sub
    
16. Sub 刷新目录()
    
17. Dim Hx As Byte
    
18. Dim Sh As Worksheet, Sh1 As Worksheet
    
19.   For Each Sh In Worksheets
    
20.     With Sh
    
21.       Lx = .Range("Iv1").End(xlToLeft).Column + 1
    
22.       Hx = 1
    
23.       If Not .Cells(1, Lx - 1).Value Like "工作表目录" And Lx > 2 Then
    
24.       .Cells(Hx, Lx).Value = "工作表目录"
    
25.         For Each Sh1 In Worksheets
    
26.           If Sh1.Name <> Sh.Name Then
    
27.             Hx = Hx + 1
    
28.             With .Cells(Hx, Lx)
    
29.               .Value = Sh1.Name
    
30.               .Font.Underline = 2
    
31.               .Font.ColorIndex = 5
    
32.               .HorizontalAlignment = 3
    
33.             End With
    
34.           End If
    
35.         Next
    
36.       End If
    
37.     End With
    
38.   Next
    
39. End Sub
    

复制代码

bbhiox

学习代码VBA                  

hcy1185

在各位老师的指导下,定稿了
Sub 生成工作表目录()
    With Sheet1
    Dim j As Long
    j = .UsedRange.SpecialCells(xlLastCell).Column + 1
        .Columns(j).Clear
        .Cells(1, j) = "工作表目录"
        m = 0
        For i = 1 To Sheets.Count
            If Sheets(i).CodeName <> Sheets(1).CodeName Then
                m = m + 1
                .Hyperlinks.Add Anchor:=.Cells(m + 1, j), Address:="", SubAddress:= _
                Sheets(i).Name & "!A1", TextToDisplay:=Sheets(i).Name
            End If
        Next i
    End With
    Sheets(1).Select
    Cells(2, j).Select
End Sub