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

Вход

Регистрация

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

 

= Мир MS Excel/Защита ячейки после редактирования - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Защита ячейки после редактирования (Макросы/Sub)
Защита ячейки после редактирования
inohodec Дата: Четверг, 27.09.2018, 18:42 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Добрый всем вечер! Есть вопрос как защитить ячейки после ввода данных! Нашёл макрос с похожей задачей но отредактировать навыков не хватает. Помогите пожалуйста.
Необходимо запретить редактирование в столбиках: D, G, L, P после тога как в ячейки введут данные.

[vba]
Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim new_value
    Dim r As Range
    Select Case Sh.Name
        Case "Лист1"
            Set r = Application.Intersect(Target, Range("Лист1!$D:$D"))
        Case Else
            Set r = Nothing
    End Select
    If r Is Nothing Then Exit Sub
    If Target.Rows.Count * Target.Columns.Count > 1 Then
        Application.Undo
        Exit Sub
    End If
    new_value = Target.Value
    Application.EnableEvents = False
    Application.Undo
    If Len(Target.Value) = 0 Then
        Target.Value = new_value
    End If
    Application.EnableEvents = True
End Sub
[/vba]
 
Ответить
СообщениеДобрый всем вечер! Есть вопрос как защитить ячейки после ввода данных! Нашёл макрос с похожей задачей но отредактировать навыков не хватает. Помогите пожалуйста.
Необходимо запретить редактирование в столбиках: D, G, L, P после тога как в ячейки введут данные.

[vba]
Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim new_value
    Dim r As Range
    Select Case Sh.Name
        Case "Лист1"
            Set r = Application.Intersect(Target, Range("Лист1!$D:$D"))
        Case Else
            Set r = Nothing
    End Select
    If r Is Nothing Then Exit Sub
    If Target.Rows.Count * Target.Columns.Count > 1 Then
        Application.Undo
        Exit Sub
    End If
    new_value = Target.Value
    Application.EnableEvents = False
    Application.Undo
    If Len(Target.Value) = 0 Then
        Target.Value = new_value
    End If
    Application.EnableEvents = True
End Sub
[/vba]

Автор - inohodec
Дата добавления - 27.09.2018 в 18:42
_Boroda_ Дата: Четверг, 27.09.2018, 19:20 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13189
Репутация: 5424 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Без Вашего файла такой вариант в модуль листа
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d_ As Range, d0_ As Range
    Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P"))
    If Not d_ Is Nothing Then
        For Each d0_ In d_
            If Not IsEmpty(d0_) Then
                d0_.Offset(1).Select
                Exit Sub
            End If
        Next d0_
    End If
End Sub
[/vba]

Чуть подправил
К сообщению приложен файл: 1487867861_1.xlsm(14.7 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995


Сообщение отредактировал _Boroda_ - Четверг, 27.09.2018, 20:07
 
Ответить
СообщениеБез Вашего файла такой вариант в модуль листа
[vba]
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim d_ As Range, d0_ As Range
    Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P"))
    If Not d_ Is Nothing Then
        For Each d0_ In d_
            If Not IsEmpty(d0_) Then
                d0_.Offset(1).Select
                Exit Sub
            End If
        Next d0_
    End If
End Sub
[/vba]

Чуть подправил

Автор - _Boroda_
Дата добавления - 27.09.2018 в 19:20
inohodec Дата: Четверг, 27.09.2018, 19:51 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо за помощь Подходит и такой вариант hands . Очень порадовало, что ячейку не то что отредактировать, а и перейти не получается :haha: . Будет теперь моим коллегам развлечение.
 
Ответить
СообщениеСпасибо за помощь Подходит и такой вариант hands . Очень порадовало, что ячейку не то что отредактировать, а и перейти не получается :haha: . Будет теперь моим коллегам развлечение.

Автор - inohodec
Дата добавления - 27.09.2018 в 19:51
inohodec Дата: Пятница, 28.09.2018, 07:44 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброе утро! А есть ещё какие то варианты защиты ячеек? На практике не совсем удобно перескакивание оказалось, а было таким прикольным! :D
Добавил свой файл.
К сообщению приложен файл: 0969876.xls(47.0 Kb)
 
Ответить
СообщениеДоброе утро! А есть ещё какие то варианты защиты ячеек? На практике не совсем удобно перескакивание оказалось, а было таким прикольным! :D
Добавил свой файл.

Автор - inohodec
Дата добавления - 28.09.2018 в 07:44
_Boroda_ Дата: Пятница, 28.09.2018, 09:40 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13189
Репутация: 5424 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Перескакивать можно не обязательно на пустую ячейку ниже, можно еще куда-нибудь
А еще вариант, например, такой (на основе выложенного Вами макроса)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range
    Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P"))
    If Not d_ Is Nothing Then
        If d_.Count > 1 Then
            Application.Undo
            Exit Sub
        End If
        Application.EnableEvents = 0
        Application.Undo
        If IsEmpty(Target) Then
            Application.Undo
        End If
        Application.EnableEvents = 1
    End If
End Sub
[/vba]
К сообщению приложен файл: 0969876_1.xls(54.5 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПерескакивать можно не обязательно на пустую ячейку ниже, можно еще куда-нибудь
А еще вариант, например, такой (на основе выложенного Вами макроса)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range
    Set d_ = Intersect(Target, Range("D:D,G:G,L:L,P:P"))
    If Not d_ Is Nothing Then
        If d_.Count > 1 Then
            Application.Undo
            Exit Sub
        End If
        Application.EnableEvents = 0
        Application.Undo
        If IsEmpty(Target) Then
            Application.Undo
        End If
        Application.EnableEvents = 1
    End If
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 28.09.2018 в 09:40
Yurbas Дата: Пятница, 28.09.2018, 15:51 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 31
Репутация: 3 ±
Замечаний: 0% ±

Excel 2010, Excel 2013
_Boroda_, подскажите решение моей проблемы на базе вашего макроса.
Имеется куча листов, в которых имеются данные и формулы, которые не нужно менять никому, кроме "посвящённых". Можно просто поставить Защиту на листы и книгу, но это не сильно "красиво". Решил воспользоваться вашим макросом, но добавил в него 1 строчку:
[vba]
Код
If Range("ZZ999").Value = 1 Then Exit Sub
[/vba]
И изменил область запрета изменений:
[vba]
Код
    Set d_ = Intersect(Target, Range("A1:BA46"))
[/vba]
Естественно, всё нормально отрабатывает. Как теперь это всё дело распространить на все листы, а их там около 20? Неужели в каждом модуле листа прописывать этот код? Или можно в модуле книги прописать этот код, но только расписать все возможные имена листов для областей запрета?


Где начало того конца, которым кончается начало?
 
Ответить
Сообщение_Boroda_, подскажите решение моей проблемы на базе вашего макроса.
Имеется куча листов, в которых имеются данные и формулы, которые не нужно менять никому, кроме "посвящённых". Можно просто поставить Защиту на листы и книгу, но это не сильно "красиво". Решил воспользоваться вашим макросом, но добавил в него 1 строчку:
[vba]
Код
If Range("ZZ999").Value = 1 Then Exit Sub
[/vba]
И изменил область запрета изменений:
[vba]
Код
    Set d_ = Intersect(Target, Range("A1:BA46"))
[/vba]
Естественно, всё нормально отрабатывает. Как теперь это всё дело распространить на все листы, а их там около 20? Неужели в каждом модуле листа прописывать этот код? Или можно в модуле книги прописать этот код, но только расписать все возможные имена листов для областей запрета?

Автор - Yurbas
Дата добавления - 28.09.2018 в 15:51
_Boroda_ Дата: Пятница, 28.09.2018, 15:56 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13189
Репутация: 5424 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
В модуле книги есть событие изменение в диапазоне Target на листе Sh
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[/vba]
На него вешаете. Кстати, так в самом первом макросе в этой теме сделано - на все листы
Вот так получится
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sh
        Dim d_ As Range
        Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P"))
        If Not d_ Is Nothing Then
            If d_.Count > 1 Then
                Application.Undo
                Exit Sub
            End If
            Application.EnableEvents = 0
            Application.Undo
            If IsEmpty(Target) Then
                Application.Undo
            End If
            Application.EnableEvents = 1
        End If
    End With
End Sub
[/vba]
К сообщению приложен файл: 0969876_2.xls(62.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеВ модуле книги есть событие изменение в диапазоне Target на листе Sh
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[/vba]
На него вешаете. Кстати, так в самом первом макросе в этой теме сделано - на все листы
Вот так получится
[vba]
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    With Sh
        Dim d_ As Range
        Set d_ = Intersect(Target, .Range("D:D,G:G,L:L,P:P"))
        If Not d_ Is Nothing Then
            If d_.Count > 1 Then
                Application.Undo
                Exit Sub
            End If
            Application.EnableEvents = 0
            Application.Undo
            If IsEmpty(Target) Then
                Application.Undo
            End If
            Application.EnableEvents = 1
        End If
    End With
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 28.09.2018 в 15:56
inohodec Дата: Пятница, 28.09.2018, 16:37 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 41
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо за помощь! Второй макрос, то что надо. hands
 
Ответить
СообщениеСпасибо за помощь! Второй макрос, то что надо. hands

Автор - inohodec
Дата добавления - 28.09.2018 в 16:37
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Защита ячейки после редактирования (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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