在执行vba宏后保留原始的excel剪贴板历史记录



背景信息

我使用VBA宏来执行一系列的几个单一步骤,以交换我的工作表内的两行内容。实际上,我因此能够逐行向上移动所选行,从而改变其相对于其他行的行顺序。为了执行这个宏,我设置了一个键盘快捷键(或按钮):


Sub MoveOneRowUp()
    Dim rowCurrent As Integer
    Dim colCurrent As Integer
    ' save current row coordinates
    rowCurrent = ActiveCell.Row
    colCurrent = ActiveCell.Column
    ' check validity
    If rowCurrent > 1 Then
        ' select row above active cell
        Rows(rowCurrent - 1).Select
        ' cut out entire row
        Selection.Cut
        ' select
        Rows(rowCurrent + 1).Select
        ' do the shift
        Selection.Insert Shift:=xlDown
        ' select previously current cell
        Cells(rowCurrent - 1, colCurrent).Select
    End If
End Sub

由于选择、剪切和插入单元格内容,宏明显地修改了剪贴板。现在,我希望剪贴板历史记录在宏执行后保持完整。因此,用户可以逆转/取消/撤回宏所做的工作,甚至可以进一步回到全局剪贴板历史。在我的Windows系统上,我通常通过按<CTRL> + <Z>来执行此操作。但是在宏执行之后,所有的剪贴板历史记录都消失了,我不能再逆转任何东西了。

在描述的情况下,我能做些什么来保留剪贴板的历史记录,而不管宏的执行情况如何?是否有一些关于EXCEL的剪贴板历史机制是如何工作的提示?

谢谢。

剪贴板可能包含各种复杂的内容,因此保存任何内容的可靠方法充其量是困难的。我认为你应该避免尝试这种方法,直到你确信没有其他方法能给你你想要的。

尝试在不更改剪贴板的情况下运行宏的问题是Excel在不复制任何内容的情况下清除剪贴板。我不知道Excel是否使用剪贴板本身,或者如果执行某些操作,它是否会自动清除剪贴板。

我尝试了一个宏,将行(当前- 1)复制到备用行,将行(当前)复制到行(当前- 1),将备用行复制到行(当前),然后清除备用行。这将当前行移动到您需要的位置,但会清除剪贴板。

下面的宏将这两行复制到变量中,然后反向复制值。根据我的测试,这并没有清除剪贴板。这个宏不复制任何格式,但如果所有行的格式都相同,这可能就足够了。

 Sub MoveOneRowUp()
  ' Integer specifies a 16-bit variable which requires special (=slow) processing
  ' on 32 and 64-bit computers.  Perhaps more importantly, the maximum value that
  ' can be held in an integer variable is 32767 so make sure your worksheets
  ' don't have too many rows.
  Dim rowCurrent As Long
  Dim colCurrent As Long
  Dim rowContents1 As Variant
  Dim rowContents2 As Variant
  ' save current row coordinates
  rowCurrent = ActiveCell.Row
  colCurrent = ActiveCell.Column
  ' check validity
  If rowCurrent > 1 Then
    ' Copy row contents to variants then copy back reversed
    rowContents1 = Rows(rowCurrent - 1).Value
    rowContents2 = Rows(rowCurrent).Value
    Rows(rowCurrent).Value = rowContents1
    Rows(rowCurrent - 1).Value = rowContents2
    ' select previously current cell
    Cells(rowCurrent - 1, colCurrent).Select
  End If
End Sub

这些潜艇将允许您使用 Ctrl + Z (撤销)和 Ctrl + Y (重做)快捷键:

.

Public Sub MoveOneRowUp()
   Dim thisRow As Long
   thisRow = ActiveCell.Row
   With ThisWorkbook.ActiveSheet.UsedRange
      If thisRow > 2 And thisRow < .Rows.Count + 1 Then  'check upper & lower bounds
         Application.ScreenUpdating = False
         'insert new row
         .Rows(thisRow - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
         .Rows(thisRow - 1).Value2 = .Rows(thisRow + 1).Value2    'copy data
         .Rows(thisRow + 1).EntireRow.Delete                      'remove initial row
         .Cells(thisRow - 1, ActiveCell.Column).Activate
         Application.OnRepeat "Move One Row Up", "MoveOneRowUp"   'updates Repeat action
         Application.OnUndo "Move One Row Down", "MoveOneRowDown" 'updates Undo action
         Application.ScreenUpdating = True
      End If
   End With
End Sub

Public Sub MoveOneRowDown()
   Dim thisRow As Long
   thisRow = ActiveCell.Row
   With ThisWorkbook.ActiveSheet.UsedRange
      If thisRow > 1 And thisRow < .Rows.Count Then      'check upper & lower bounds
         Application.ScreenUpdating = False
         'insert new row
         .Rows(thisRow + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
         .Rows(thisRow + 2).Value2 = .Rows(thisRow + 0).Value2    'copy data
         .Rows(thisRow + 0).EntireRow.Delete                      'remove initial row
         .Cells(thisRow + 1, ActiveCell.Column).Activate
         Application.OnRepeat "Move One Row Up", "MoveOneRowUp"   'updates Repeat action
         Application.OnUndo "Move One Row Down", "MoveOneRowDown" 'updates Undo action
         Application.ScreenUpdating = True
      End If
   End With
End Sub

MSDN的详细信息

最新更新