修改活頁簿名稱

henry860608

檔案中有針對修改活頁簿名稱去管理，但是無法管理工作表頁面中，使已經存在工作表名稱不要修改，是否有程式撰寫上得錯誤。

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2. 'Updateby MMC&LBC 107.09.11
   
3. Dim i As Integer
   
4. Dim Name, code, t As String
   
5. Dim xR, fd, PW As Range
   
6. Dim wSheet As Worksheet
   
7. 
   
8.    code = ":/\?*[]"
   
9.    Set xR = Cells(Rows.Count, "C").End(xlUp)(2)
   
10.      
    
11.      If xR.Row > 1 Then
    
12.      While xR = ""
    
13.      xR = ActiveSheet.Name                 '在工作表單維護中
    
14.      Wend
    
15.    
    
16.      With Sheets("工作表單維護")
    
17.      Set fd = .Columns(3).Cells.Find(ActiveSheet.Name, LookIn:=xlValues, lookat:=xlWhole) '在C欄搜尋工作表名稱之內容看看使否已經存在該筆資料
    
18.      
    
19.         If fd Is Nothing Then
    
20.            MsgBox "工作表單維護中無工作表: " & xR & " ，需更改工作表名稱!", , "更改工作表名稱!"
    
21.            For Each wSheet In Worksheets
    
22.            With Sheets("工作表單維護")
    
23.            Set fd = .Columns(3).Cells.Find(Name, LookIn:=xlValues, lookat:=xlWhole) '在C欄搜尋工作表名稱之內容看看使否已經存在該筆資料
    
24.            If wSheet.Name = xR Then
    
25. 10            Name = InputBox("請輸入工作表名稱！" & vbNewLine & "原名稱:" & wSheet.Name, "更改工作表名稱", , 8000, 4000) '提示
    
26.                  i = 1: t = Mid(Name, i, 1)
    
27.                  If Len(Name) > 31 Then
    
28.                     MsgBox "工作表名稱大於31個字元!": GoTo 10
    
29.                  ElseIf Len(Name) = 0 Then
    
30.                     MsgBox "工作表名稱空白!": GoTo 10
    
31.                  ElseIf InStr(1, code, t) > 0 Then: i = i + 1
    
32.                     MsgBox "工作表名稱有特殊字元！": GoTo 10
    
33.                  ElseIf Not fd Is Nothing Then
    
34.                     MsgBox "工作表名稱重複！": GoTo 10
    
35.                  Else
    
36.                     ActiveSheet.Name = Name
    
37.                  End If
    
38.            End If
    
39.            End With
    
40.            Next wSheet
    
41.         End If
    
42.      End With
    
43.      End If
    
44.    
    
45. End Sub

複製代碼

准提部林

看不懂邏輯及流程~~
最好逐步描述~~~