Изменение названия ярлыка листа щелчком по ячейкам

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Изменение названия ярлыка листа щелчком по ячейкам (Макросы/Sub)

Dalm

Дата: Среда, 07.08.2024, 18:37 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 92

Репутация: 0 ±

Замечаний: 0% ±

Excel 2019

Здравствуйте.
Помогите изменить макрос.

Сейчас при щелчке на текст в любом месте диапазоне G4:V5 - название ярлыка листа меняется (на текст ячейки, по которой щелкнули).

Как изменить макрос, чтобы он менял название всегда - по тексту ячейки F3 ?
(А щелчки по кнопкам - меняли бы содержимое ячейки F3)

То есть щелчок по диапазону G4:V4 - меняет левую часть формулы "=J4&L5" в ячейке F3 (и меняет название ярлыка)
То есть щелчок по диапазону G5:V5 - меняет правую часть формулы "=J4&L5" в ячейке F3 (и меняет название ярлыка)

Прикладываю файл-пример.

К сообщению приложен файл: fajl2_1.xlsm (22.0 Kb)

Ответить

MikeVol

Дата: Четверг, 08.08.2024, 12:59 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 378

Репутация: 80 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

Dalm, Доброго времени суток. Ещё один вариант от меня, приведённый ниже код вставьте в Модуль ЭтаКнига (ThisWorkbook): [vba]

Код

Option Explicit

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

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
        Cancel = True

        ' Обновление ячейки F3 на основе выбранной ячейки
        If Not Intersect(Target, Sh.Range("G4:V4")) Is Nothing Then
            Sh.Range("F3").Formula = "=" & Target.Address & "&" & Mid(Sh.Range("F3").Formula, InStr(Sh.Range("F3").Formula, "&") + 1)

        ElseIf Not Intersect(Target, Sh.Range("G5:V5")) Is Nothing Then
            Sh.Range("F3").Formula = Left(Sh.Range("F3").Formula, InStr(Sh.Range("F3").Formula, "&")) & Target.Address
        End If

        ' Получение нового имени листа из ячейки F3
        Dim newName As String: newName = Sh.Range("F3").Value

        ' Проверка на длину имени и недопустимые символы
        If Len(newName) <= 31 And InStr(newName, ":") = 0 And InStr(newName, "\") = 0 Then
            On Error Resume Next
            Sh.Name = newName

            If Err.Number <> 0 Then
                MsgBox "Не удалось переименовать лист. Возможно, лист с таким именем уже существует или имя недопустимо.", vbExclamation
                Err.Clear
            End If

            On Error GoTo 0
        Else
            MsgBox "Имя листа не должно быть пустым, содержать недопустимые символы и быть длиной не более 31 символа.", vbExclamation
        End If

    End If

End Sub

[/vba] И как обычно от меня, остальной код что есть у вас удалите, весь! Удачи.

Код