Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Расширение форматированной таблицы при защите листа - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расширение форматированной таблицы при защите листа (Макросы/Sub)
Расширение форматированной таблицы при защите листа
Leprotto Дата: Среда, 16.03.2016, 15:57 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Друзья-товарищи! Нужен макрос добавляющий строки в конце форматированной таблицы при условии заполнения любой ячейки в ближайшей свободной строке.
И все это когда лист защищен %)
К сообщению приложен файл: stroki.xlsm(10Kb)
 
Ответить
СообщениеДрузья-товарищи! Нужен макрос добавляющий строки в конце форматированной таблицы при условии заполнения любой ячейки в ближайшей свободной строке.
И все это когда лист защищен %)

Автор - Leprotto
Дата добавления - 16.03.2016 в 15:57
KuklP Дата: Среда, 16.03.2016, 16:13 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

Нам еще и пароль на лист ломать? Используйте при защите макросом параметр usernterfaceonly:=true


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеНам еще и пароль на лист ломать? Используйте при защите макросом параметр usernterfaceonly:=true

Автор - KuklP
Дата добавления - 16.03.2016 в 16:13
Manyasha Дата: Среда, 16.03.2016, 16:24 | Сообщение № 3
Группа: Модераторы
Ранг: Старожил
Сообщений: 1590
Репутация: 669 ±
Замечаний: 0% ±

Excel 2007, 2010
Leprotto, у Вас сама таблица защищена, как ее изменять?)
В формате ячеек убрала "защищаемая ячейка" с диапазона таблицы.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set r = Intersect(Target, Range("Таблица1"))
    If Not r Is Nothing Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect "1"
        lr = [a1].CurrentRegion.Rows.Count
        ActiveSheet.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
        ActiveSheet.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]
KuklP, в ячейке I2 указан пароль(1) :p
К сообщению приложен файл: stroki-1.xlsm(17Kb)


marinamorozova_box@mail.ru
ЯД: 410013299366744 WM: R193491431804
 
Ответить
СообщениеLeprotto, у Вас сама таблица защищена, как ее изменять?)
В формате ячеек убрала "защищаемая ячейка" с диапазона таблицы.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set r = Intersect(Target, Range("Таблица1"))
    If Not r Is Nothing Then
        Application.EnableEvents = False
        ActiveSheet.Unprotect "1"
        lr = [a1].CurrentRegion.Rows.Count
        ActiveSheet.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
        ActiveSheet.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]
KuklP, в ячейке I2 указан пароль(1) :p

Автор - Manyasha
Дата добавления - 16.03.2016 в 16:24
Leprotto Дата: Среда, 16.03.2016, 16:32 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Manyasha, отлично! Спасибо respect
 
Ответить
СообщениеManyasha, отлично! Спасибо respect

Автор - Leprotto
Дата добавления - 16.03.2016 в 16:32
KuklP Дата: Среда, 16.03.2016, 16:59 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

KuklP, в ячейке I2 указан пароль(1)
я пытался его вводить, выдает ошибку. Экс 2010

Блин, я его вместе со словом пароль вводил :(
К сообщению приложен файл: 3277928.gif(49Kb)


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Среда, 16.03.2016, 17:01
 
Ответить
Сообщение
KuklP, в ячейке I2 указан пароль(1)
я пытался его вводить, выдает ошибку. Экс 2010

Блин, я его вместе со словом пароль вводил :(

Автор - KuklP
Дата добавления - 16.03.2016 в 16:59
KuklP Дата: Среда, 16.03.2016, 22:46 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

ActiveSheet.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
Если сделать так, то нижерасположенные строки не пострадают, будут сдвигаться(ну и ActiveSheet здесь употреблять можно, но вызовет ненужные вычисления, лучше использовать зарезервированный объект Ме):
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set r = Intersect(Target, Range("Таблица1"))
    If Not r Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect "1"
        lr = [a1].CurrentRegion.Rows.Count
        ll = Me.ListObjects(1).Range.Rows.Count
        For i = 1 To 3 - (ll - lr)
            Me.ListObjects(1).ListRows.Add ll, True
        Next
'        Me.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
        Me.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение
ActiveSheet.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
Если сделать так, то нижерасположенные строки не пострадают, будут сдвигаться(ну и ActiveSheet здесь употреблять можно, но вызовет ненужные вычисления, лучше использовать зарезервированный объект Ме):
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Set r = Intersect(Target, Range("Таблица1"))
    If Not r Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect "1"
        lr = [a1].CurrentRegion.Rows.Count
        ll = Me.ListObjects(1).Range.Rows.Count
        For i = 1 To 3 - (ll - lr)
            Me.ListObjects(1).ListRows.Add ll, True
        Next
'        Me.ListObjects("Таблица1").Resize Range("a1:g" & lr + 3)
        Me.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]

Автор - KuklP
Дата добавления - 16.03.2016 в 22:46
Leprotto Дата: Четверг, 17.03.2016, 14:09 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
Manyasha, вчера открыл "stroki-1" попробовал, все работало.
Сегодня попытался внедрить макрос в реальный файл. Ничего не получилось.
Более того перестал работать вчерашний файл (даже при повторной загрузке).
KuklP, Ваш тоже пытался применить. Безуспешно.
Ничего не понимаю :'(
К сообщению приложен файл: real.xlsx(28Kb)
 
Ответить
СообщениеManyasha, вчера открыл "stroki-1" попробовал, все работало.
Сегодня попытался внедрить макрос в реальный файл. Ничего не получилось.
Более того перестал работать вчерашний файл (даже при повторной загрузке).
KuklP, Ваш тоже пытался применить. Безуспешно.
Ничего не понимаю :'(

Автор - Leprotto
Дата добавления - 17.03.2016 в 14:09
KuklP Дата: Четверг, 17.03.2016, 14:16 | Сообщение № 8
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

У меня работает файл из №3.


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеУ меня работает файл из №3.

Автор - KuklP
Дата добавления - 17.03.2016 в 14:16
Leprotto Дата: Четверг, 17.03.2016, 14:20 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 78
Репутация: 0 ±
Замечаний: 20% ±

Excel 2013
KuklP, и у меня вчера работало.
Посмотрите, пожалуйста, реальный файл.
"Таблица31" (A34-L45), заполнение ячеек в столбцах B-H
К сообщению приложен файл: 5670105.xlsx(28Kb)
 
Ответить
СообщениеKuklP, и у меня вчера работало.
Посмотрите, пожалуйста, реальный файл.
"Таблица31" (A34-L45), заполнение ячеек в столбцах B-H

Автор - Leprotto
Дата добавления - 17.03.2016 в 14:20
KuklP Дата: Четверг, 17.03.2016, 15:03 | Сообщение № 10
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

Дело в том, что у Вас в таблице ВСЕ строки заполнены. Формулы, проверка данных и т. д. Попробуйте. Столбцы C:I
К сообщению приложен файл: _real.xlsm(37Kb)


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Четверг, 17.03.2016, 15:09
 
Ответить
СообщениеДело в том, что у Вас в таблице ВСЕ строки заполнены. Формулы, проверка данных и т. д. Попробуйте. Столбцы C:I

Автор - KuklP
Дата добавления - 17.03.2016 в 15:03
KuklP Дата: Четверг, 17.03.2016, 18:18 | Сообщение № 11
Группа: Проверенные
Ранг: Старожил
Сообщений: 2006
Репутация: 436 ±
Замечаний: 20% ±

Еще вариант:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица31")) Is Nothing Then
        Application.EnableEvents = False
        With Me.ListObjects("Таблица31")
            Me.Unprotect "1"
            For lr& = .ListRows.Count To 2 Step -1
                n& = n& + 1
                If Application.CountA(.ListRows(lr&).Range) > 3 Then Exit For
            Next
            For i& = 1 To 4 - n&
                .ListRows.Add lr + 1, True
            Next
        End With
        Me.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеЕще вариант:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("Таблица31")) Is Nothing Then
        Application.EnableEvents = False
        With Me.ListObjects("Таблица31")
            Me.Unprotect "1"
            For lr& = .ListRows.Count To 2 Step -1
                n& = n& + 1
                If Application.CountA(.ListRows(lr&).Range) > 3 Then Exit For
            Next
            For i& = 1 To 4 - n&
                .ListRows.Add lr + 1, True
            Next
        End With
        Me.Protect "1"
        Application.EnableEvents = True
    End If
End Sub
[/vba]

Автор - KuklP
Дата добавления - 17.03.2016 в 18:18
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расширение форматированной таблицы при защите листа (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!