Доброго всем времени суток, уважаемые!!!! Появилась интересная задачка, которую сам решить к сожалению не могу в инпут, текст и прочих боксах просто очень слаб. Есть лист панель управления. на нем имеется некий список . Есть листы, которые называются так же, как и список. Есть необходимость добавления листов по шаблону. То есть если надо добавить лист фирма, то он д.б. скопирован с листа фирма с добавлением цифры 2. если опять надо добавить лист фирма, то он опять копируется с того же листа фирма но уже с цифрой 3. ну и так далее. Прошу вашей помощи!!!
Доброго всем времени суток, уважаемые!!!! Появилась интересная задачка, которую сам решить к сожалению не могу в инпут, текст и прочих боксах просто очень слаб. Есть лист панель управления. на нем имеется некий список . Есть листы, которые называются так же, как и список. Есть необходимость добавления листов по шаблону. То есть если надо добавить лист фирма, то он д.б. скопирован с листа фирма с добавлением цифры 2. если опять надо добавить лист фирма, то он опять копируется с того же листа фирма но уже с цифрой 3. ну и так далее. Прошу вашей помощи!!! китин
Игорь, привет. В файле была какая-нибудь форма? Сейчас нет ничего, кроме листов. Как узнать, какой лист будем сейчас добавлять (напр. по даблклику в ячейке с именем шаблона)?
Игорь, привет. В файле была какая-нибудь форма? Сейчас нет ничего, кроме листов. Как узнать, какой лист будем сейчас добавлять (напр. по даблклику в ячейке с именем шаблона)?Manyasha
Вот как раз по даблклику и написал Как обычно для Игоря, с комментариями [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim sh_ As Worksheet, sh1_ As Worksheet If Target = "" Then Exit Sub 'если даблкликнули на пустую ячейку - выход из макроса For Each sh_ In ThisWorkbook.Worksheets 'цикл по листам книги If InStr(sh_.Name, Target) = 1 Then 'если имя листа начинается со значения той ячейки, куда топнули Set sh1_ = sh_ 'назначему этому листу обзывалку "sh1_" и проверяем остальные листы 'в итоге находим самый правый лист, удовлетворяющий условию End If Next sh_ If sh1_ Is Nothing Then Exit Sub 'если никому не назначили "sh1_", то выход из макроса Application.ScreenUpdating = 0 'отключаем обновление экрана With sh1_ 'работа с листом "sh1_" shn0_ = .Name 'его имя For i = 1 To Len(shn0_) 'цикл от 1 до количества символов в имени If IsNumeric(Right(shn0_, i)) Then 'если i знаков справа - число, то ind_ = Right(shn0_, i) 'присваиваем переменной значение этого числа Else 'иначе Exit For 'выход из цикла End If Next i 'конец цикла. i всегда на единицу больше количества цифр справа у имени листа ind_ = ind_ + 1 'получаем новое число для нового листа Cancel = True 'запрещаем проваливаться в ячейку при даблклике .Copy after:=sh1_ 'копируем найденный лист вправо от себя shn_ = Left(shn0_, Len(shn0_) - i + 1) & ind_ 'отрубаем от названия старого листа все буквы слева 'и приклеиваем ind_ Worksheets(.Index + 1).Name = shn_ 'переназываем новый лист End With Me.Activate 'активируем лист "Панель управления" Application.ScreenUpdating = 1 'включаем обновление экрана End Sub
[/vba]
Вот как раз по даблклику и написал Как обычно для Игоря, с комментариями [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim sh_ As Worksheet, sh1_ As Worksheet If Target = "" Then Exit Sub 'если даблкликнули на пустую ячейку - выход из макроса For Each sh_ In ThisWorkbook.Worksheets 'цикл по листам книги If InStr(sh_.Name, Target) = 1 Then 'если имя листа начинается со значения той ячейки, куда топнули Set sh1_ = sh_ 'назначему этому листу обзывалку "sh1_" и проверяем остальные листы 'в итоге находим самый правый лист, удовлетворяющий условию End If Next sh_ If sh1_ Is Nothing Then Exit Sub 'если никому не назначили "sh1_", то выход из макроса Application.ScreenUpdating = 0 'отключаем обновление экрана With sh1_ 'работа с листом "sh1_" shn0_ = .Name 'его имя For i = 1 To Len(shn0_) 'цикл от 1 до количества символов в имени If IsNumeric(Right(shn0_, i)) Then 'если i знаков справа - число, то ind_ = Right(shn0_, i) 'присваиваем переменной значение этого числа Else 'иначе Exit For 'выход из цикла End If Next i 'конец цикла. i всегда на единицу больше количества цифр справа у имени листа ind_ = ind_ + 1 'получаем новое число для нового листа Cancel = True 'запрещаем проваливаться в ячейку при даблклике .Copy after:=sh1_ 'копируем найденный лист вправо от себя shn_ = Left(shn0_, Len(shn0_) - i + 1) & ind_ 'отрубаем от названия старого листа все буквы слева 'и приклеиваем ind_ Worksheets(.Index + 1).Name = shn_ 'переназываем новый лист End With Me.Activate 'активируем лист "Панель управления" Application.ScreenUpdating = 1 'включаем обновление экрана End Sub