Excel：禁用剪切、复制，但允许将 function 粘贴到 Excel 和 VBA

Question

我有禁用 Excel 中的剪切、复制和粘贴功能的代码。但我需要允许粘贴 function，以便能够从其他 excel（例如 C3:E10）粘贴到我的 excel。 任何帮助将不胜感激

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

Answer 1

根据我对您问题的理解，您可以使用Intersect function 允许粘贴到 Excel 工作表中的特定范围。

Private allowedRange As Range

Private Sub Workbook_Open()
    ' Set the allowed range where pasting is allowed
    Set allowedRange = ThisWorkbook.Worksheets("Sheet1").Range("C3:E10")
End Sub

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

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

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

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

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ' Check if the selected range intersects with the allowed range
    If Not Intersect(Target, allowedRange) Is Nothing Then
        ' Allow pasting to the selected range
        Application.OnKey "^v"
    Else
        ' Disable pasting to the selected range
        Application.OnKey "^v", ""
    End If
End Sub

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

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Application.CutCopyMode = False
End Sub

这会将允许粘贴的允许范围设置为“Sheet1”中的C3:E10 。