代码运行两次才可执行

朱付安

代码运行两次才可以运行，老师给看看怎么回事，另外我只想冻结目录工作表其他工作表正常就可以

维叶

把冻结命令从函数移到过程中去，

1. Sub 创建目录()
   
2.     Dim sht As Worksheet
   
3.      If Not ShtExists("目录") Then
   
4.         Set sht = Sheets.Add(before:=Sheets(1))
   
5.         sht.Name = "目录"
   
6.         With ActiveWindow
   
7.         .SplitColumn = 0
   
8.         .SplitRow = 2
   
9.         .FreezePanes = True
   
10.         End With
    
11.     Else
    
12.         Set sht = Sheets("目录")
    
13.          sht.Activate
    
14.           With ActiveWindow
    
15.         .SplitColumn = 0
    
16.         .SplitRow = 2
    
17.         .FreezePanes = True
    
18.         End With
    
19.     End If
    
20.     sht.[A1] = "序号"
    
21.     sht.[B1] = "目录"
    
22.     sht.[2:10000].ClearContents
    
23.     For i = 2 To Sheets.Count
    
24.         sht.Cells(i, 1) = i - 1
    
25.         sht.Cells(i, 2) = Sheets(i).Name
    
26.         '主表添加超链接
    
27.         sht.Hyperlinks.Add Anchor:=sht.Cells(i, 2), Address:="", SubAddress:= _
    
28.         "'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
    
29.         '子表添加返回超链接
    
30.               If Sheets(i).Range("A1") = "" Or Sheets(i).Range("A1") = "返回目录" Then
    
31.             Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), Address:="", SubAddress:= _
    
32.                 "目录!B" & i, TextToDisplay:="返回目录"
    
33.         Else
    
34.              Sheets(i).Select
    
35.              Sheets(i).Columns(1).Select
    
36.              Selection.Insert Shift:=xlToRight
    
37.             Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Range("A1"), Address:="", SubAddress:= _
    
38.                 "目录!B" & i, TextToDisplay:="返回目录"
    
39.         End If
    
40.     Next
    
41.     Range("A:A，B1").HorizontalAlignment = xlCenter                                               'A列B1水平对齐
    
42.     Range("A1:B1").Font.Bold = True                                                               '设置A1:B1单元格的字体为加粗
    
43.     ActiveSheet.Columns("b:b").AutoFit
    
44.     Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Borders.LineStyle = xlContinuous           '添加边框
    
45.     Range("B2:B200").Font.Underline = xlUnderlineStyleNone                                        '去除超链接下划线
    
46. End Sub
    
47. Function ShtExists(shtname)
    
48.     '判断Sheet表是否存在
    
49.     On Error Resume Next
    
50.      Dim s
    
51.     Err.Clear
    
52.     s = Sheets(shtname & "").Name
    
53.     If Err.Number = 0 Then
    
54.         ShtExists = True
    
55.     Else
    
56.         ShtExists = False
    
57.     End If
    
58. End Function

复制代码

朱付安

维叶 发表于 2024-3-14 12:14
把冻结命令从函数移到过程中去，

谢谢老师，我看看

朱付安

维叶 发表于 2024-3-14 12:14
把冻结命令从函数移到过程中去，

老师，这个代码还是得运行两次，才能达到我想要的效果，两次的运行结果不同

维叶

我试了不用两次啊，

你想要的效果是，只想冻结目录工作表，其他工作表正常就可以？

朱付安

维叶 发表于 2024-3-14 14:27
我试了不用两次啊，

你想要的效果是，只想冻结目录工作表，其他工作表正常就可以？

是的老师，我再试试您的这个

朱付安

维叶 发表于 2024-3-14 14:27
我试了不用两次啊，

你想要的效果是，只想冻结目录工作表，其他工作表正常就可以？

好了老师，刚才是真奇怪，谢谢

一条小笨笨

参与一下,供测试