сохраняют первоначальную первенствовать историю буфера обмена после выполнения макроса VBA

Question

справочной информации

Я использую 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?

Спасибо.

Answer 1

Буфер обмена может содержать множество сложных вещей, поэтому надежный способ сохранения любого содержимого будет в лучшем случае трудным. Я считаю, что вам следует избегать попытки такого подхода, пока вы не убедитесь, что никакой другой подход не даст вам то, что вы хотите.

Проблема с попыткой запуска макроса без изменения буфера обмена заключается в том, что 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 

Answer 2

Эти подводные лодки позволит использовать Ctrl + Z (Undo) и Ctrl + Y (Redo) ярлыки:

,

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