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

时间：2010-05-25 16:15:54

标签： excel vba excel-vba

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

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

示例：
工作表1：

  

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

工作表2 :(第二行被锁定）

  

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

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

  

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

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

  • 我一直在想着有一个钩子在哪里粘贴，锁定的单元格被解锁，以便粘贴可以发生，然后恢复到原始值并重新锁定。
  • 我是否可以通过某种方式遍历剪贴板中的单元格，只粘贴目标未锁定的单元格？
  • 最好不要为粘贴创建单独的按钮，因此对用户的影响较小，但如果这是唯一的方法，我不反对。
  • 目前，我计划将锁定的行组合在一起，以便数据输入单元格是连续的，但随后帐户将出现故障，这不是首选。

4 个答案:

答案 0 :(得分：2)

要求：

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

    4. 方法：

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

      8. 我参考Jan Karel的Catch Paste样本作为参考。您可能希望添加他捕获粘贴操作的所有方法。

      在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

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

      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

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

答案 1 :(得分：0)

在处理了许多剪切和粘贴问题后，我可以说问题的简单解决方案是创建一个按钮来完成整个副本。只有当他们总是从同一个工作簿中复制时，这才会（轻松）工作（尽管如果需要，你可以编写一个更复杂的界面）。

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

答案 2 :(得分：0)

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

在以前版本的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

编辑：在发布该答案后，我意识到在Excel中，默认情况下所有呼叫都被标记为已锁定。因此，如果他们从普通纸张粘贴，那么目标单元格可能会读取“已锁定”，因为过去只是锁定它！所以我有一个改进的方法，它允许你将一些东西粘贴到一张纸上，它只会保持“锁定”单元格完好无损。

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

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

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

答案 3 :(得分：0)

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

我听说在以后的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

通过这个我们捕获主菜单，上下文菜单和Ctrl-V键 - 这应该足够了。 OnAction属性转移到参数

中包含的子 
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

我添加这个是因为它表明你必须关心缓冲区中的内容（excel，text，html等）

您需要使用

代码替换TrappedPaste（）例程的核心

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

2）取消保护目标表

3）在

的条件下逐个单元地将内容移动到目标范围

4）目标细胞满足没有锁定，验证或类似的条件

5）重新保护目标表

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

请注意，使用这样的构造，用户将无法使用UNDO函数！

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

相关问题
最新问题