首页 > 解决方案 > VBA - 粘贴事件和撤消粘贴的最后一个动作

问题描述

我正在尝试使用 VBA 使我的 excel 粘贴值而不是 PasteAll。但由于线路故障,我无法实现它:

lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)

我正在使用如下代码。谁能帮我解决这个问题?如果我错了,请更正我的代码。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lastAction As String

Application.ScreenUpdating = False
Application.EnableEvents = False

lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)


If Left(lastAction, 5) = "Paste" Then

Application.ScreenUpdating = True
Application.EnableEvents = True

Application.Undo


Selection.PasteSpecial Paste:=xlPasteValues

End If

End Sub

标签: excelvba

解决方案


After including above code, I understood that this doesn't helps if the content copied was not from Excel. Below code helps to handle the data from both Office Clipboard and Windows Clipboard.

Office Clipboard - Paste as Values Windows Clipboard - Paste as text


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) Dim UndoList As String

Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo Whoa

'~~> Get the undo List to capture the last action performed by user
UndoList = Application.CommandBars("Standard").Controls("&Undo").List(1)

'~~> Check if the last action was not a paste nor an autofill
If Left(UndoList, 5) = "Paste" Or UndoList = "Paste special" Then

Application.ScreenUpdating = True


On Error GoTo 0

'~~> Undo the paste that the user did but we are not clearing the
'~~> clipboard so the copied data is still in memory
Application.Undo


'~~> Do a pastespecial to preserve formats

'~~> Handle text data copied from a website
 
'Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
'Target.PasteSpecial Paste:="Text", Operation:=xlNone, SkipBlanks:=False

 Call Paste_Event


On Error GoTo 0

'~~> Retain selection of the pasted data
Union(Target, Selection).Select

End If

Application.EnableEvents = True

LetsContinue: Application.ScreenUpdating = True Application.EnableEvents = True Exit Sub Whoa: MsgBox Err.Description Resume LetsContinue

End Sub

Private Sub Paste_Event()

On Error GoTo Paste Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Exit Sub On Error GoTo 0 Paste: Selection.PasteSpecial Paste:="Text", Operation:=xlNone, SkipBlanks:=False Exit Sub

End Sub



推荐阅读