變更工作表名稱

myleoyes

各位前輩你們好!!
         Sub 變更名稱()
Dim Z
    If MsgBox("您確定要變更工作表名稱嗎?", vbYesNo) = vbYes Then
Again:
       Z = Application.InputBox("輸入名稱", "        請輸入工作表名稱", " 必須是文字 ", Type:=2)
          If Z = "" Or Z = False Then GoTo Again
          ' MsgBox("你所輸入名稱已存在請重新輸入!")
          [C3] = ActiveCell.Row
          If [C3] = 7 Then
          Sheet2.Select
          ElseIf [C3] = 8 Then
          Sheet4.Select
          ElseIf [C3] = 9 Then
          Sheet6.Select
          ElseIf [C3] = 10 Then
          Sheet8.Select
          End If
          ActiveSheet.Name = Z
    ElseIf vbNo Then
          Exit Sub
    End If
         清除工作表
End Sub
         問題如附檔說明
         請知道的前輩,不吝賜教謝謝再三!!

Hsieh

回復 1# myleoyes

1. Private Sub Worksheet_SelectionChange(ByVal T As Range)
   
2.      Select Case T(1).Address(0, 0)
   
3.         Case "A2"
   
4.               ActiveWindow.ScrollColumn = 1
   
5.     End Select
   
6.     With T(1)
   
7.         If .Column = 1 And (.Row >= 7 And .Row <= 36) And T(1) <> "" Then 變更名稱 .Row
   
8.     End With
   
9. End Sub

複製代碼

1. Sub 變更名稱(k)
   
2. Dim Z
   
3.     If MsgBox("您確定要變更工作表名稱嗎?", vbYesNo) = vbYes Then
   
4. Again:
   
5.        Z = Application.InputBox("輸入名稱", "        請輸入工作表名稱", " 必須是文字 ", Type:=2)
   
6.           If Z = "" Or Z = False Then GoTo Again
   
7.           ' MsgBox("你所輸入名稱已存在請重新輸入!")
   
8.           Set a = Columns("A").Find(Z, lookat:=xlWhole)
   
9.           If Not a Is Nothing Then MsgBox "你所輸入名稱已存在請重新輸入!": GoTo Again
   
10.           ActiveCell = Z
    
11.           Sheets((k - 6) * 2).Select
    
12.           ActiveSheet.Name = Z
    
13.     ElseIf vbNo Then
    
14.           Exit Sub
    
15.     End If
    
16.          清除工作表
    
17. End Sub

複製代碼

myleoyes

回復 2# Hsieh
偶像前輩!謝謝!
       程式無法辨別相同名
       執行階段錯誤為1004
       還有判定是否為文字加入下面幾行為何無法判定是字串呢?
       For I = 1 To Len(Z)
                If Mid(Z, I, 1) Like "[!0-9]" Then Msg = True: '判定是字串
            Next
          If Z < False Then GoTo Again
          If Z > False Then GoTo Again
          If Z = False Then Exit Sub
        再麻煩前輩!指導謝謝再三!!

Hsieh

回復  Hsieh
偶像前輩!謝謝!
       程式無法辨別相同名
       執行階段錯誤為1004
       還有判定 ...
myleoyes 發表於 2013-3-31 17:41

無法判定同名工作表，可能輸入的Z值不在A欄的清單內，而A欄清單並不是所有工作表名稱

1. Sub 變更名稱(k)
   
2. Dim Z, Sht As Object
   
3. Set Sht = CreateObject("Scripting.Dictionary")
   
4. For Each sh In Sheets
   
5.   Sht(sh.Name) = sh.Name
   
6. Next
   
7.     If MsgBox("您確定要變更工作表名稱嗎?", vbYesNo) = vbYes Then
   
8. Again:
   
9.        Z = Application.InputBox("輸入名稱", "        請輸入工作表名稱", " 必須是文字 ", Type:=2)
   
10.           If Z = "" Or Z = False Then GoTo Again
    
11.           ' MsgBox("你所輸入名稱已存在請重新輸入!")
    
12.          
    
13.           If Sht.exists(Z) Then MsgBox "你所輸入名稱已存在請重新輸入!": GoTo Again
    
14.           ActiveCell = Z
    
15.           Sheets((k - 6) * 2).Select
    
16.           ActiveSheet.Name = Z
    
17.     ElseIf vbNo Then
    
18.           Exit Sub
    
19.     End If
    
20.          清除工作表
    
21. End Sub

複製代碼

myleoyes

回復 4# Hsieh
像前輩!辛苦囉謝謝再三!!