1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
|
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strSheetName As String
Dim wks As Worksheet
Dim IllegalCharacter(1 To 7) As String
Dim I As Integer
If Target.Address(0, 0) = "O31" Then
Select Case Target.Value
Case "", 1, 2, 3, 4, 5
Range("a1:a200").EntireRow.Hidden = False
Range("a35:a50").EntireRow.Hidden = True
Case 6
Range("a1:a200").EntireRow.Hidden = False
End Select
End If
'Specify the target cell whose entry shall be the sheet tab name.
If Target.Address(0, 0) <> "E11" Then Exit Sub
'If the target cell is empty (contents cleared) then do not change the shet name
If IsEmpty(Target) Then Exit Sub
'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
If Len(Target.Value) > 31 Then
MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
"You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
IllegalCharacter(1) = "/"
IllegalCharacter(2) = "\"
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For I = 1 To 7
If InStr(Target.Value, (IllegalCharacter(I))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
"Please re-enter a sheet name without the ''" & IllegalCharacter(I) & "'' character.", 48, "Not a possible sheet name !!"
Application.EnableEvents = False
Target.ClearConloltents
Application.EnableEvents = True
Exit Sub
End If
Next I
'Verify that the proposed sheet name does not already exist in the workbook.
strSheetName = Trim(Target.Value)
On Error Resume Next
Set wks = ActiveWorkbook.Worksheets(strSheetName)
'If the worksheet name does not already exist, name the active sheet as the target cell value.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If Not wks Is Nothing Then
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Else
ActiveSheet.Name = strSheetName
End If
End Sub |
Partager