修改活頁簿名稱

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-12-20 19:03 | 只看該作者

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

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Updateby MMC&LBC 107.09.11
Dim i As Integer
Dim Name, code, t As String
Dim xR, fd, PW As Range
Dim wSheet As Worksheet
code = ":/\?*[]"
Set xR = Cells(Rows.Count, "C").End(xlUp)(2)
If xR.Row > 1 Then
While xR = ""
xR = ActiveSheet.Name '在工作表單維護中
Wend
With Sheets("工作表單維護")
Set fd = .Columns(3).Cells.Find(ActiveSheet.Name, LookIn:=xlValues, lookat:=xlWhole) '在C欄搜尋工作表名稱之內容看看使否已經存在該筆資料
If fd Is Nothing Then
MsgBox "工作表單維護中無工作表: " & xR & " ，需更改工作表名稱!", , "更改工作表名稱!"
For Each wSheet In Worksheets
With Sheets("工作表單維護")
Set fd = .Columns(3).Cells.Find(Name, LookIn:=xlValues, lookat:=xlWhole) '在C欄搜尋工作表名稱之內容看看使否已經存在該筆資料
If wSheet.Name = xR Then
10 Name = InputBox("請輸入工作表名稱！" & vbNewLine & "原名稱:" & wSheet.Name, "更改工作表名稱", , 8000, 4000) '提示
i = 1: t = Mid(Name, i, 1)
If Len(Name) > 31 Then
MsgBox "工作表名稱大於31個字元!": GoTo 10
ElseIf Len(Name) = 0 Then
MsgBox "工作表名稱空白!": GoTo 10
ElseIf InStr(1, code, t) > 0 Then: i = i + 1
MsgBox "工作表名稱有特殊字元！": GoTo 10
ElseIf Not fd Is Nothing Then
MsgBox "工作表名稱重複！": GoTo 10
Else
ActiveSheet.Name = Name
End If
End If
End With
Next wSheet
End If
End With
End If
End Sub