Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Нужен способ запретить вставлять значения/форматы в ячейки
 
#1
08.02.2024 23:22:09
Доброе ночь
Есть список допустимых значений в колонке 1 и бланк заказа питания в колонках 3-5. Подразумевается, что пользователь будет использовать выпадающий список в колонке 4. По факту в лист с заказом вставляются значения/форматы из сторонних источников. Значения, вставленные в колонку 4, не соответствуют списку допустимых значений из колонки 1, да и в целом эти копипастеры портят лист левыми форматами в других колонках.

Можно ли строго запретить в данной книге что-либо вставлять в ячейку? В идеале должен быть допустим только ручной ввод значений и использование выпадающего списка. На этом форуме наткнулась на данный код, но он запрещает копировать ячейку в пределах книги. Если в буфере обмена что-то уже есть или скопировано из строки ячейки, никто не запретит вставить это безобразие в ячейку.

Код
Private Sub Workbook_Activate()
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
Application.CutCopyMode = False
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Application.CellDragAndDrop = True
Application.OnKey "^c"
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.OnKey "^c", ""
Application.CellDragAndDrop = False
Application.CutCopyMode = False
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Application.CutCopyMode = False
End Sub
Изменено: neira - 08.02.2024 23:46:46
 
 
 
#2
09.02.2024 06:46:17
neira,
как вариант, можно проверять на вставку значений не из списка, но всегда есть шанс, что макросы будут отключены в настройках и не помогут)))
Код
Dim стар
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
стар = Target
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Set p = Range("Меню")
    If Target.Cells.Count > 1 Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If WorksheetFunction.CountIf(p, Target) = 0 Then
            Target = стар
        End If
    End If
End Sub
 
 
 
#3
09.02.2024 07:40:47
Можно же просто проверять содержимое ячеек и, если оно не соответствует содержимому меню, очищать такие ячейки.
Навесить эту проверку можно на событие сохранения файла и/или на событие деактивации листа.
А чтобы человек сразу видел, что вставил какую-то ерунду в ячейку, можно просто использовать условное форматирование, чтобы значения не из списка подкрашивались каким-нибудь агрессивным фоном (красным например).
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#4
09.02.2024 07:56:04
Михаил Лебедев,
думаю, что еще не помешала бы проверка форматов наверное, т.к. знаечение может быть из "меню", но форматы ячейки совсем другие
 
 
 
#5
09.02.2024 08:07:24
Цитата
написал:
не помешала бы проверка форматов
Проще было бы где-то спрятать ячейку с нужным форматом и в макросе дописать команду скопировать-вставить формат из спрятанной ячейки в столбец заказов.
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#6
09.02.2024 08:16:17
Цитата
написал:
но всегда есть шанс, что макросы будут отключены
чтобы этот шанс исключить, надо макросом делать лист видимым при открытии и невидимым - при закрытии книги. В этом случае при отключенных макросах пользователь просто не увидит тот лист, с которым хотел бы поработать в обход макросов. А при включенных макросах - сам этот лист спрячет при закрытии книги.
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#7
09.02.2024 10:35:35
evgeniygeo, очень похоже на решение
А можно ли сделать так, чтоб ячейка не возвращала прежнее содержимое, а очищала содержимое?  
 
 
 
#8
09.02.2024 10:38:08
neira,
поменяйте одну строку с:
Код
Target = стар

на:
Код
Target = ""


и вот этот кусок тогда вообще можно удалить:
Код
Dim стар
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
стар = Target
Application.EnableEvents = True
End Sub
Изменено: evgeniygeo - 09.02.2024 10:42:46
 
 
 
#9
09.02.2024 10:39:49
evgeniygeo, огонь
Большое спасибо, опробую сегодня на кошках  
 
 
 
#10
09.02.2024 10:41:59
Михаил Лебедев,
согласен, либо взять exe или vbs из статьи Дмитрия:
https://www.excel-vba.ru/chto-umeet-excel/kak-zapustit-fajl-s-vklyuchennymi-makrosami/
Изменено: evgeniygeo - 09.02.2024 10:47:35
 
 
 
#11
09.02.2024 11:38:10
Цитата
написал:
как вариант,
Как написал создатель темы, при работе с файлом злобствуют копипастеры, а они могут и не по одной ячейке копипастить.
Поэтому вот этот фрагмент в Вашем коде меня смутил:
Код
    If Target.Cells.Count > 1 Then Exit Sub
Тут бы, по хорошему, не Exit Sub надо, а в цикле пробежать по всем ячейкам. С проверкой по Intersect в том числе.
Изменено: Михаил Лебедев - 09.02.2024 11:41:52
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
#12
09.02.2024 11:53:52
evgeniygeo
Переместила меню на другой лист и макросу кажется это не понравилось  :oops:  
Изменено: neira - 09.02.2024 11:54:04
 
 
 
#13
09.02.2024 12:30:16
Михаил Лебедев,
абсолютно с Вами согласен и тоже об это думал, но код 1 в 1 забрал из приема Николая, поэтому даже не стал заморачиваться  :D

думаю, что можно так, но с Intersect не понял, расскажите???
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
    Set p = Range("Меню")
    If Not Intersect(Target, Range("D:D")) Is Nothing Then
        For n = Target.Row To Target.Row + Target.Rows.Count - 1
            If WorksheetFunction.CountIf(p, Cells(n, 4)) = 0 Then
                Target = ""
            End If
        Next
    End If
Application.EnableEvents = True
End Sub
Изменено: evgeniygeo - 09.02.2024 13:08:23
 
 
 
#14
09.02.2024 12:34:05
neira,
строчка должна измениться + про наименование диапазона в Диспетчере имен забыли
Код
    Set p = Sheets("Справочник").Range("Меню")
 
 
 
#15
09.02.2024 13:16:58
evgeniygeo, Михаил Лебедев,
Все огонь, большое спасибо
Изменено: neira - 09.02.2024 13:17:16
 
 
 
#16
12.02.2024 06:39:21
Цитата
написал:
но с Intersect не понял, расскажите???
я имел ввиду, что если кому-то приспичит вставить диапазон ячеек, который только частично принадлежит нужному нам диапазону, то логика рушится. Поэтому по-хорошему надо пробегать в цикле все ячейки из Target. Если ячейка принадлежит диапазону, то проверять ее значение на соответствие требованиям.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myR As Range
    
    Set p = Range("Меню")
    
    Application.EnableEvents = False
        For Each myR In Target.Cells
'            myR = проверка(myR, p)
'            проверка = myR
            If Not Intersect(myR, Range("D:D")) Is Nothing Then
                If WorksheetFunction.CountIf(p, myR) = 0 Then
                    myR = Empty
                End If
            End If
        Next
    Application.EnableEvents = True
End Sub
Изменено: Михаил Лебедев - 12.02.2024 06:40:36
Всё сложное - не нужно. Всё нужное - просто /М. Т. Калашников/
 
 
 
Страницы: 1
Наверх