На каждом листе - есть диапазон G4:V5 - с текстом. Как сменить название ярлыка листа - на тот тот текст, который записан в ячейку по которой кликнули ?
(Событие рабочего листа - одинарный клик мышкой по ячейке из диапазона G4:V5 )
Здравствуйте. Помогите разобраться с задачей.
На каждом листе - есть диапазон G4:V5 - с текстом. Как сменить название ярлыка листа - на тот тот текст, который записан в ячейку по которой кликнули ?
(Событие рабочего листа - одинарный клик мышкой по ячейке из диапазона G4:V5 )Dalm
Dalm, Доброго времени суток. Возможно кто лучше вам напишит код. Как вариант, приведённый ниже код вставьте в Модуль ЭтаКнига (ThisWorkbook): [vba]
Код
Option Explicit
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Sh.Range("G4:V5")) Is Nothing Then
If Target.Value <> "" Then
' Проверка на длину имени и недопустимые символы If Len(Target.Value) <= 31 And InStr(Target.Value, ":") = 0 And InStr(Target.Value, "\") = 0 Then Sh.Name = Target.Value
If Err.Number <> 0 Then MsgBox "Не удалось переименовать лист. Возможно, лист с таким именем уже существует или имя недопустимо.", vbExclamation Err.Clear End If
Else MsgBox "Имя листа не должно быть пустым, содержать недопустимые символы и быть длиной не более 31 символа.", vbExclamation End If
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("G2:R2")) Is Nothing Then
With Sh.Tab .Color = Target.Interior.Color .TintAndShade = 0 End With
End If
End Sub
[/vba] Да, ещё. Остальной код что есть у вас в Модулях Листов Удалите, весь! ЯЯ переписал его, теперь код один и срабатывает для всех Листов. Удачи.
Dalm, Доброго времени суток. Возможно кто лучше вам напишит код. Как вариант, приведённый ниже код вставьте в Модуль ЭтаКнига (ThisWorkbook): [vba]
Код
Option Explicit
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Sh.Range("G4:V5")) Is Nothing Then
If Target.Value <> "" Then
' Проверка на длину имени и недопустимые символы If Len(Target.Value) <= 31 And InStr(Target.Value, ":") = 0 And InStr(Target.Value, "\") = 0 Then Sh.Name = Target.Value
If Err.Number <> 0 Then MsgBox "Не удалось переименовать лист. Возможно, лист с таким именем уже существует или имя недопустимо.", vbExclamation Err.Clear End If
Else MsgBox "Имя листа не должно быть пустым, содержать недопустимые символы и быть длиной не более 31 символа.", vbExclamation End If
End If
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Sh.Range("G2:R2")) Is Nothing Then
With Sh.Tab .Color = Target.Interior.Color .TintAndShade = 0 End With
End If
End Sub
[/vba] Да, ещё. Остальной код что есть у вас в Модулях Листов Удалите, весь! ЯЯ переписал его, теперь код один и срабатывает для всех Листов. Удачи.MikeVol