☰

阻止用戶貼上，但允許貼上值

tag-icon • tag-icon microsoft-excel worksheet-function vba
阻止用戶貼上，但允許貼上值

我的工作簿中有以下程式碼，它阻止使用者完全貼上任何內容。

我的需求現在已經改變，我希望能夠讓用戶僅貼上值。

有辦法實現這一點嗎？

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
Private Sub Workbook_Open()
    MsgBox "Copying and Pasting into the skills matrix has been disabled to prevent changes in the workbook functionality."
End Sub

答案1

此 VBA 程式碼應該執行以下操作：

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    Target.PasteSpecial xlPasteValues
    Application.CutCopyMode = True
End Sub

答案2

根據我之前的回答，這可行嗎？

因此，我們檢查是否貼上了某些內容，然後保存該值，撤銷貼上並僅重新插入該值。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim UndoList As String, StoreValue As String
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoList, 5) = "Paste" Then
    StoreValue = Target.Value
    With Application
        .EnableEvents = False
        .Undo
    End With
    Target.Value = StoreValue
End If
Application.EnableEvents = True
End Sub

如果評論中的建議不是更好的解決方案。

答案3

我成功嘗試的另一種方法可能是這樣的：

劫持 CTRL+C 和 CTRL+V，使其只貼特殊值。

因此，透過使用原始工作簿代碼，但替換 

Application.OnKey "^c", ""

和

Application.OnKey "^{v}", "pasteValues"
Application.OnKey "^{c}", "copyValues"

然後使用以下內容製作一個模組：

Public copyVal As String
Private Sub pasteValues()
selection = copyVal
End Sub
Private Sub copyValues()
copyVal = selection
End Sub

現在您可以複製和貼上，但它只會移動值。

相關內容