Любопытно, есть ли у кого-нибудь решение. Вот мой код ниже, и я думал, что он работает отлично. Мы использовали его в течение долгого времени, а кто-то еще указывал на то, что они делают все время, что вызывает ошибку сценария.Ошибка Excel VB Application.Undo & ActiveSheet.Protect
Что делает этот код, это не позволяет кому-то обновлять более одной ячейки за раз. Если кто-то копирует большой фрагмент данных, где он занимает более одной строки или столбца при вставке в Excel, например, копирование электронной почты и вставка его в электронную таблицу, появляется всплывающее предупреждение, в котором говорится, что он не изменяет более одной ячейки в то время, а затем он отменит пасту. Эта часть отлично работает.
Что делает кто-то, что вызывает ошибку, они будут выбирать ячейку и где она имеет этот квадрат в правом нижнем углу ячейки, который вы можете щелкнуть и перетащить, чтобы заполнить или переместить, они будут выбирать это и заполнить. Если вы заполняете только одну ячейку, это не проблема. Проблема в том, когда они делают это с двумя или более ячейками, то есть при возникновении ошибки. Более конкретно на линии, которая говорит Application.Undo.
Таким образом, проблема действительно не связана с линией Application.Undo, на самом деле она заблокирована. Если бы я должен был прочесть строки, которые говорят ActiveSheet.Unprotect и ActiveSheet.Protect, тогда код работает нормально. Однако я хочу, чтобы он был защищен. Существует гораздо больше кода, чем то, что у меня есть здесь, но это всего лишь фрагмент его, и у меня есть ячейки, правильно отформатированные, поэтому правильные блокируются, а другие нет. Вы должны иметь возможность взять код и вставить его в новую электронную таблицу, и он будет работать, поэтому вы можете видеть, о чем я говорю, однако сначала убедитесь, что вы сначала разблокируете некоторые ячейки, чтобы их можно было отредактировать. После того, как вы это сделаете, чтобы увидеть эту ошибку, воспользуйтесь защитными/защитными линиями, чтобы повторить попытку, и код будет работать без каких-либо проблем.
Пожалуйста, дайте мне знать, если у кого-то есть решение, поэтому я могу сохранить защищенную электронную таблицу и спасибо за любую помощь!
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim vClear As Variant
Dim vData As Variant
Dim lFirstRow As Long
Dim lLastRow As Long
'This prevents more than one cell from being changed at once.
'If more than one cell is changed then validation checks will not work.
If Target.Cells.Count > 1 Then
vData = Target.Formula
For Each vClear In vData
If vClear <> "" Then 'If data is only deleted then more than one cell can be changed.
MsgBox "Change only one cell at a time", , "Too Many Changes!"
Application.Undo
Exit For
Else
'If data is deleted this will check to see what columns are being deleted.
'Deleting certain columns will also allow for the automatic deletion of other columns not selected.
If vClear = "" Then
'If the target includes columns D, it will also clear columns M & N.
If Not Intersect(Target, Columns("D")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column M & N.
ActiveSheet.Range(Cells(lFirstRow, 13), Cells(lLastRow, 13)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns G, it will also clear columns I & K & N.
If Not Intersect(Target, Columns("G")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K & N.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 14), Cells(lLastRow, 14)).ClearContents
End If
'If the target includes columns H, it will also clear columns I & K.
If Not Intersect(Target, Columns("H")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column I & K.
ActiveSheet.Range(Cells(lFirstRow, 9), Cells(lLastRow, 9)).ClearContents
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
'If the target includes column J, it will also clear column K.
If Not Intersect(Target, Columns("J")) Is Nothing Then
'Gets the first row in the target range.
lFirstRow = Target.Rows(1).Row
'Gets the last row in the target range.
lLastRow = lFirstRow + Target.Rows.Count - 1
'Clears the contents of corresponding rows in column K.
ActiveSheet.Range(Cells(lFirstRow, 11), Cells(lLastRow, 11)).ClearContents
End If
End If
End If
Next
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
ActiveSheet.Unprotect
Dim iFirstCol As Integer
Dim iLastCol As Integer
Dim iFirstRow As Integer
Dim iLastRow As Integer
Dim iColor As Integer
'''Only adjust the below numbers to fit your desired results.'''
iFirstCol = 1 'Change this number to the number of the first column that needs to be highlighted. Column A = 1.
iLastCol = 15 'Change this number to the number of the last column that needs to be highlighted. Column A = 1.
iFirstRow = 7 'Change this number to the number of the first row that needs to be highlighted.
iLastRow = 500 'Change this number to the number of the last row that needs to be highlighted.
iColor = 20 'Change this number to use a different highlight color.
'''End of changes, do not change anything else.'''
If Target.Count = 1 Then
'The row highlight will only be applied if the selected range is within this if statement criteria.
If Target.Row > iFirstRow - 1 And Target.Row < iLastRow + 1 And Target.Column > iFirstCol - 1 And Target.Column < iLastCol + 1 Then
'Resets the color within the full range when cell selection changed.
ActiveSheet.Range(ActiveSheet.Cells(iFirstRow, iFirstCol), ActiveSheet.Cells(iLastRow, iLastCol)).Interior.Color = xlNone
'Applies the colors to the row.
For counter = iFirstCol To iLastCol
With ActiveSheet.Cells(Target.Row, iFirstCol).Interior
.ColorIndex = iColor
.Pattern = xlSolid
End With
iFirstCol = iFirstCol + 1
Next counter
End If
End If
ActiveSheet.Protect
Application.EnableEvents = True
End Sub
Перемещение разрешено для пользователей? Если перетаскивание вызывает эту проблему, почему бы вам не отключить перетаскивание ячеек? –
Да, это нормально, если они перетаскиваются в одну ячейку, чтобы разрешить одно изменение, но это действительно не нужно, но это нормально, если пользователь предпочитает его использовать. Если нет другого варианта, я мог бы отключить его, хотя я не был уверен, что смогу, пока вы его не подтвердите, но подумал о том же и подумал о том, чтобы найти возможный код, чтобы отключить его. Я бы предпочел, чтобы это было последним средством. Если вы должны знать, как его отключить, можете ли вы отправить код, пожалуйста, если я должен идти по этому маршруту? Это был бы мой последний вариант. Спасибо – Chris
'Применение.CellDragAndDrop = False' и не уверен, почему вы пытаетесь найти трудное решение, когда есть простой доступный. Более того, ваша идея состоит в том, чтобы разрешить пользователю одиночную запись только на листе. Не так ли? –