vba 允许在工作表中粘贴而不覆盖锁定的单元格

Allow paste in worksheet without overwriting locked cells

提问by jjeaton

I have a protected worksheet that users would like to copy and paste into. I have no control over the workbook they are copying from.

我有一个受保护的工作表，用户希望将其复制并粘贴到其中。我无法控制他们从中复制的工作簿。

The protected worksheet has some rows that are available for data entry, and other rows that are locked and greyed out to the user. The users would like to be able to paste over the top of the entire worksheet from another random workbook and have all the cells available for data entry filled in, while the locked cells are undisturbed. In the current state, the user gets an error when they try to paste, because it cannot paste over the locked cells.

受保护的工作表具有一些可用于数据输入的行，以及其他被锁定并对用户显示为灰色的行。用户希望能够从另一个随机工作簿粘贴到整个工作表的顶部，并填充所有可用于数据输入的单元格，而锁定的单元格不受干扰。在当前状态下，用户在尝试粘贴时会收到错误消息，因为它无法粘贴到锁定的单元格上。

Example:
Worksheet 1:

示例：
工作表 1：

Act1 100 100 100
Act2 100 100 100
Act3 100 100 100

Act1 100 100 100
Act2 100 100 100
Act3 100 100 100

Worksheet 2: (The second row is locked)

工作表2：（第二行被锁定）

Act1 300 300 300
Act2 200 200 200
Act3 100 100 100

Act1 300 300 300
Act2 200 200 200
Act3 100 100 100

After copying/pasting Worksheet 2 should look like this:

复制/粘贴工作表 2 后应如下所示：

Act1 100 100 100
Act2 200 200 200
Act3 100 100 100

Act1 100 100 100
Act2 200 200 200
Act3 100 100 100

The values from worksheet 1 are populated and the locked rows are undisturbed.

工作表 1 中的值已填充，锁定的行不受干扰。

• I've been thinking along the lines of having a hook where on paste, the locked cells are unlocked so that the paste can happen, and then are reverted to their original values and relocked.
• Is there some way I can loop through the cells in the clipboard and only paste cells where the target isn't locked?
• It is preferable to not create a separate button for paste, so there is less impact on the users, but if that's the only way, I'm not opposed to it.
• Currently, I plan on grouping the locked rows together, so that the data entry cells are contiguous, but then the accounts will be out of order, which is not preferred.

• 我一直在思考在粘贴时有一个钩子，锁定的单元格被解锁以便粘贴可以发生，然后恢复到它们的原始值并重新锁定。
• 有什么方法可以遍历剪贴板中的单元格并只粘贴目标未锁定的单元格吗？
• 最好不要创建单独的粘贴按钮，这样对用户的影响较小，但如果这是唯一的方法，我不反对。
• 目前，我计划将锁定的行分组在一起，以便数据输入单元格是连续的，但随后帐户将无序，这不是首选。

采纳答案by Adarsha

Requirements:

要求：

1. Allow pasting into protected sheets
2. Retain content in the locked cells after paste operation
3. Retain protection status of the sheet

1. 允许粘贴到受保护的工作表中
2. 粘贴操作后保留锁定单元格中的内容
3. 保留工作表的保护状态

Method:

方法：

1. Handle all possible paste operations in user defined module, instead of Excel's way
2. Since unprotecting removes contents from clipboard paste to a temp sheet
3. make a note of user intended paste location
4. make a note of locked cells in the protected sheet (content and address)
5. unprotect the sheet
6. paste to intended cells from temp sheet
7. remove temp sheet and protect main sheet

1. 在用户定义的模块中处理所有可能的粘贴操作，而不是 Excel 的方式
2. 由于取消保护会将内容从剪贴板粘贴到临时表
3. 记下用户预期的粘贴位置
4. 记下受保护工作表中锁定的单元格（内容和地址）
5. 取消保护工作表
6. 从临时表粘贴到预期的单元格
7. 移除临时表并保护主表

I referred to Jan Karel's Catch Pastesample for reference. You might want to add all the ways he is catching paste operations.

我参考了 Jan Karel 的Catch Paste示例以供参考。您可能想要添加他捕获粘贴操作的所有方式。

In the ThisWorkbook module add below code

在 ThisWorkbook 模块中添加以下代码

Private mdNextTimeCatchPaste As Double

Private Sub Workbook_Activate()
    REM Add Paste event handler
    CatchPaste
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    REM Restore Paste event handler
    StopCatchPaste
    mdNextTimeCatchPaste = Now
    Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name & "'!UnProtectPasteToSheet"
End Sub


Private Sub Workbook_Deactivate()
    REM Restore Paste event handler
    StopCatchPaste
    On Error Resume Next
    REM Cancel scheduled macroREM s,
    REM because we might be closing the file
    Application.OnTime mdNextTimeCatchPaste, "'" & ThisWorkbook.Name & "'!UnProtectPasteToSheet", , False
End Sub

Private Sub Workbook_Open()
    REM Add Paste event handler
    CatchPaste
End Sub

Add a new Module and add below code

添加一个新模块并添加以下代码

REM Add Paste event handler
Public Sub CatchPaste()
REM these are the ways you can Paste in to Excel
REM refer to http://www.jkp-ads.com/articles/catchpaste.asp for more details
Application.OnKey "^v", "UnProtectPasteToSheet"
Application.OnKey "^{Insert}", "UnProtectPasteToSheet"
Application.OnKey "+{Insert}", "UnProtectPasteToSheet"
Application.OnKey "~", "UnProtectPasteToSheet"
Application.OnKey "{Enter}", "UnProtectPasteToSheet"
End Sub
REM restore all default events
Public Sub StopCatchPaste()
Application.OnKey "^v", ""
Application.OnKey "^{Insert}", ""
Application.OnKey "+{Insert}", ""
Application.OnKey "~", ""
Application.OnKey "{Enter}", ""
End Sub

REM Here we will check the sheet is protected, if it is then paste to a temp sheet,
REM unprotect main sheet, paste the values, and restore locked cells
Private Sub UnProtectPasteToSheet()
On Error GoTo ErrHandler
Dim bProtected As Boolean, oSheet As Worksheet, oTempSheet As Worksheet, sPasteLocation As String
Dim oCell As Range, oCollAddress As New Collection, oCollValue As New Collection, iCount As Integer

REM check protection status
If Not ThisWorkbook.ActiveSheet.ProtectContents Then
    Selection.PasteSpecial Paste:=xlAll
Else
    bProtected = True
    Set oSheet = ThisWorkbook.ActiveSheet
    REM save paste location
    sPasteLocation = Selection.Address
    REM unprotecting clears Clipboard in Excel!! strange but true..
    REM So paste it to a new sheet before unprotecting
    Set oTempSheet = ThisWorkbook.Worksheets.Add
    REM oSheet.Visible = xlSheetVeryHidden
    oTempSheet.Paste
    REM unprotect the sheet
    oSheet.Unprotect

    REM make a note of all locked cells
    For Each oCell In oSheet.UsedRange
        If oCell.Locked Then
            oCollAddress.Add oCell.Address
            oCollValue.Add oCell.Value
        End If
    Next

    REM paste
    oTempSheet.UsedRange.Copy
    oSheet.Activate
    oSheet.Range(sPasteLocation).Select
    REM you need to paste only values since pasting format will lock all those cells
    REM since in Excel default status is "Locked"
    Selection.PasteSpecial xlValues

    REM remove temp sheet
    Application.DisplayAlerts = False
    oTempSheet.Delete
    Application.DisplayAlerts = True

    REM restore locked cells
    For iCount = 1 To oCollAddress.Count
        Range(oCollAddress.Item(iCount)) = oCollValue.Item(iCount)
    Next
    REM restore protection
    oSheet.Protect

End If
Exit Sub

ErrHandler:
    Debug.Print Err.Description
    If bProtected Then
        ThisWorkbook.ActiveSheet.Protect
    End If
End Sub

Note: I am adding REMinstead of 'to keep the Stackoverflow formatter happy. Give it a try and let me know how it goes..

注意：我添加REM而不是'让 Stackoverflow 格式化程序满意。试一试，让我知道它是怎么回事..

回答by MikeD

I think the key is to gracefully block standard Paste function and redo the Paste in a controlled way

我认为关键是优雅地阻止标准粘贴功能并以受控方式重做粘贴

I heared that in later Excel versions there is a "On-Paste" event (not sure), but this is not available in 2003. I trap Paste actions by the following code in 2003 (which is called by a suitable event procedure like Sheet_Activate() ):

我听说在以后的 Excel 版本中有一个“On-Paste”事件（不确定），但这在 2003 年不可用。我在 2003 年通过以下代码捕获粘贴操作（由合适的事件过程调用，如 Sheet_Activate () ):

Sub SetPasteTrap(Mode As Boolean)
' TRUE sets the trap, FALSE releases trap
    If Mode Then
        Application.CommandBars("Edit").Controls("Paste").OnAction = "TrappedPaste"
        Application.CommandBars("Edit").Controls("Paste Special...").OnAction = "TrappedPaste"
        Application.CommandBars("Cell").Controls("Paste").OnAction = "TrappedPaste"
        Application.CommandBars("Cell").Controls("Paste Special...").OnAction = "TrappedPaste"
        Application.OnKey "^v", "TrappedPaste"
    Else
        Application.CommandBars("Edit").Controls("Paste").OnAction = ""
        Application.CommandBars("Edit").Controls("Paste Special...").OnAction = ""
        Application.CommandBars("Cell").Controls("Paste").OnAction = ""
        Application.CommandBars("Cell").Controls("Paste Special...").OnAction = ""
        Application.OnKey "^v"
    End If
End Sub

By this we trap main menu, context menu and the Ctrl-V key - that should be enough. The OnAction property diverts to the sub contained in the argument

这样我们就可以捕获主菜单、上下文菜单和 Ctrl-V 键——这应该足够了。OnAction 属性转移到参数中包含的 sub

Sub TrappedPaste()
    If ActiveSheet.ProtectContents Then
        ' as long as sheet is protected, we don't paste at all
        MsgBox "Sheet is protected, all Paste/PasteSpecial functions are disabled." & vbCrLf & _
               "At your own risk you may unprotect the sheet." & vbCrLf & vbCrLf & _
               "When unprotected, you can copy/paste from other text, WORD, HTML or EXCEL files." & vbCrLf & _
               "All Paste operations will implicitly be executed as PasteSpecial/Values", _
               vbOKOnly, "Paste"
        Exit Sub
    End If

    ' silently do a PasteSpecial/Values
    On Error GoTo TryExcel
    ' try to paste text
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
    Exit Sub
TryExcel:
    On Error GoTo DoesntWork
    Selection.PasteSpecial xlPasteValues
    Exit Sub
DoesntWork:
    MsgBox "Sorry - wrong format for pasting", vbExclamation + vbOKOnly, "PasteSpecial ..."
End Sub

I am adding this because it shows that you must care a bit what is in the buffer (excel, text, html, etc.)

我添加这个是因为它表明您必须关心缓冲区中的内容（excel、文本、html 等）

You would need to substitute the core of the TrappedPaste() routine by a code that

您需要用以下代码替换 TrappedPaste() 例程的核心

1) pastes the content into a hidden sheet/range (you can use the code above)

1）将内容粘贴到隐藏的工作表/范围中（您可以使用上面的代码）

2) unprotects the target sheet

2) 取消保护目标表

3) moves the content to the target range cell by cell on the condition that

3) 将内容逐个单元格移动到目标范围，条件是

4) the target cell fulfills the condition of not having a lock, validation or similar

4）目标单元满足没有锁定、验证或类似条件

5) re-protects the target sheet

5) 重新保护目标表

6) empty the hidden sheet/range

6）清空隐藏的工作表/范围

Note that with such a construct the user will not be able to use the UNDO function!

请注意，使用这种构造，用户将无法使用 UNDO 功能！

Hope that helps - Good Luck MikeD

希望有所帮助 - 祝你好运 MikeD

回答by Lance Roberts

Having dealt with many of the cutting and pasting issues, I can say that the simple solution to the problem is to create a button that will do the entire copy. This will only work (easily) if they're always copying from the same workbook (though you could program a more complicated interface if you needed to).

在处理了许多剪切和粘贴问题之后，我可以说解决这个问题的简单方法是创建一个按钮来完成整个复制。如果他们总是从同一个工作簿中复制，这只会（很容易）起作用（尽管如果需要，您可以编写更复杂的界面）。

The code can survey the locked cells, then selectively break up the copied cells into contiguous ranges, and paste each individual range.

该代码可以调查锁定的单元格，然后有选择地将复制的单元格分解为连续的范围，并粘贴每个单独的范围。

回答by Adarsha

You can actually abort the paste operation if you detect the Paste area overlaps with the locked cells. In fact Office-2007 does this for you, if any of the the cells being pasted are locked and the sheet is protected then Office-2007 fails the Paste operation wnd throws an error message.

如果您检测到粘贴区域与锁定的单元格重叠，您实际上可以中止粘贴操作。实际上，Office-2007 会为您执行此操作，如果要粘贴的任何单元格被锁定并且工作表受到保护，则 Office-2007 会失败粘贴操作 wnd 会引发错误消息。

In previous versions of the Excel and in un-protected sheets (but with few locked cells, which does not serve any purpose) you can have a function to undo the changes if any of the cells being modified is locked.

在以前版本的 Excel 和未受保护的工作表中（但几乎没有锁定的单元格，这没有任何作用）您可以拥有一个功能，如果正在修改的任何单元格被锁定，则可以撤消更改。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim oCell As Range
For Each oCell In Target
    If oCell.Locked = True Then
        'disable events to prevent recursive function call
       Application.EnableEvents = False
       'undo the paste
       Application.Undo
       'enable events
       Application.EnableEvents = True
       Exit For
    End If
Next
End Sub

Edit: After posting that answer I realised that in Excel all the calls are marked as Locked by default. So if they paste from an ordinary sheet, then chances are the destination cell will read "Locked" because the past just locked it!! So I have an improved way, which will allow you to paste some thing to a sheet, it will just keep the "Locked" cells intact.

编辑：发布该答案后，我意识到在 Excel 中，默认情况下所有调用都标记为锁定。因此，如果他们从普通工作表粘贴，那么目标单元格很可能会显示为“已锁定”，因为过去刚刚锁定了它！所以我有一个改进的方法，它可以让你将一些东西粘贴到一张纸上，它只会保持“锁定”单元格的完整性。

The idea here is we will capture the new status after the paste, and then undo all the changes. Then we will loop through the cells that were just changed and check if they were locked before Paste operation. If they were not, then we will repopulate the pasted value. Using this code you will get the results you were asking in your example.

这里的想法是我们将在粘贴后捕获新状态，然后撤消所有更改。然后我们将遍历刚刚更改的单元格并检查它们是否在粘贴操作之前被锁定。如果不是，那么我们将重新填充粘贴的值。使用此代码，您将获得您在示例中要求的结果。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim oCell As Range, oCollAddress As New Collection, oCollValue As New Collection, iCount As Integer
'get all pasted content in to a collection
For Each oCell In Target
    oCollAddress.Add oCell.Address
    oCollValue.Add oCell.Value
Next

'undo the changes done, and re-paste it for unlocked cells
'disable events to prevent infinite calls
Application.EnableEvents = False
Application.Undo
For iCount = 1 To oCollAddress.Count
    If Range(oCollAddress.Item(iCount)).Locked = False Then
        Range(oCollAddress.Item(iCount)) = oCollValue.Item(iCount)
    End If
Next
Application.EnableEvents = True
End Sub

Edit 5/27/2010: Okay, then you need to capture Paste operation (event), and handle it manually instead of Excel. I am adding a new answer since that is too big..

2010 年 5 月 27 日编辑：好的，那么您需要捕获粘贴操作（事件），并手动而不是 Excel 处理它。我正在添加一个新答案，因为它太大了..