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

Question

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

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

示例:
工作表 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 中的值已填充，锁定的行不会受到干扰。

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

Answer 1

要求:

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

方法:

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

我提到了 Jan Karel 的 Catch Paste sample 供引用。您可能想要添加他捕获粘贴操作的所有方式。

在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 格式化程序满意。尝试一下，让我知道进展如何..