Question

我使用了一个excel宏，它通过撤消粘贴并将其粘贴为值，自动将所有数据粘贴为值。这是代码：

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, 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" And UndoList <> "Auto Fill" _
Then GoTo LetsContinue

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

If UndoList = "Auto Fill" Then Selection.Copy

'~~> Do a pastespecial to preserve formats
On Error Resume Next
'~~> Handle text data copied from a website
Target.Select
ActiveSheet.PasteSpecial Format:="Text", _
Link:=False, DisplayAsIcon:=False

Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
On Error GoTo 0

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

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

我正在使用英语Excel版本，它可以正常工作，但是当其他用户，例如有一个德国Excel版本粘贴的东西，他们在这一行得到一个程序错误：

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

我猜Undo命令在德语中的命名方式不同。有没有办法定义撤消列表独立于用户使用的语言？

Answer 1

改为使用Control的Id编号。

debug.Print Application.CommandBars("Standard").Controls("&Undo").Id
=> 128 

debug.Print Application.CommandBars("Standard").FindControl(Id:=128).caption
=> &Undo

Answer 2

使用索引作为名称：

undoname = Application.CommandBars("Standard").FindControl(ID:=128).Index
UndoList = Application.CommandBars("Standard").Controls(undoname).List(i)

Answer 3

您还应该在代码中替换单词＆＃34;粘贴＆＃34;，＆＃34;自动填充＆＃34;和＆＃34;文字＆＃34;用于您当地的语言单词。

Answer 4

非常有用的代码。谢谢。也可以这样做：

UndoList = Application.CommandBars("Standard").FindControl(ID:=128).List(1)

VBA：请参阅独立的Excel Undolist语言

4 个答案: