Как сохранить данные буфера обмена после смены книг в vba?

Question

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

cell = "k7: l" & row 
Worksheets(1).Range(cell).Select 


Selection.Copy 
relpath = ThisWorkbook.Path & "\" & "DispersionList.xls" 

If Dir(relpath) <> "" Then 
    Application.Workbooks.Open (relpath) 
    Workbooks("DispersionList.xls").Activate 
Else 
    Call createWorkbook 
End If 

Worksheets(1).Cells(7, 14).Select 
Selection.PasteSpecial 


End Sub 

если я запускаю через код построчно и проверить буфер обмена он теряет свое содержимое на workbooks.open линии

Answer 1

Есть несколько действий в Excel/VBA, что приведет к аннулированию выбора/буфера , например изменение любых параметров окна/экрана. Таким образом, я подозреваю, что при изменении рабочего листа/рабочей книги вызывается какое-то событие.

Вы можете либо отладить его, либо пропуская код, когда выбор отменен, и избегать этого утверждения (если это возможно).

В качестве альтернативы, используйте код subStoreClipboard и subRestoreClipboard ниже кода вашего кода мероприятия. Чтобы использовать код, вставьте его в новый модуль на рабочем листе, а также вставьте новый (скрытый) лист, который называется «ws_Temp» в VBA.

Private mIntCutCopyMode As XlCutCopyMode 
Private mRngClipboard As Range 

Public Sub subStoreClipboard() 
    On Error GoTo ErrorHandler 
    Dim wsActiveSource As Worksheet, wsActiveTarget As Worksheet 
    Dim strClipboardRange As String 

    mIntCutCopyMode = Application.CutCopyMode 

    If Not fctBlnIsExcelClipboard Then Exit Sub 


    Application.EnableEvents = False 

    'Paste data as link 
    Set wsActiveTarget = ActiveSheet 
    Set wsActiveSource = ThisWorkbook.ActiveSheet 

    With ws_Temp 
     .Visible = xlSheetVisible 
     .Activate 
     .Cells(3, 1).Select 
     On Error Resume Next 
     .Paste Link:=True 
     If Err.Number Then 
      Err.Clear 
      GoTo Finalize 
     End If 
     On Error GoTo ErrorHandler 
    End With 

    'Extract link from pasted formula and clear range 
    With Selection 
     strClipboardRange = Mid(.Cells(1, 1).Formula, 2) 
     If .Rows.Count > 1 Or .Columns.Count > 1 Then 
      strClipboardRange = strClipboardRange & ":" & _ 
       Mid(.Cells(.Rows.Count, .Columns.Count).Formula, 2) 
     End If 
     Set mRngClipboard = Range(strClipboardRange) 
     .Clear 
    End With 

Finalize: 
    wsActiveSource.Activate 
    wsActiveTarget.Parent.Activate 
    wsActiveTarget.Activate 

    ws_Temp.Visible = xlSheetVeryHidden 
    Application.EnableEvents = True 

    Exit Sub 
ErrorHandler: 
    Err.Clear 
    Resume Finalize 
End Sub 


Public Sub subRestoreClipboard() 
    Select Case mIntCutCopyMode 
     Case 0: 
     Case xlCopy: mRngClipboard.Copy 
     Case xlCut: mRngClipboard.Cut 
    End Select 

End Sub 

Private Function fctBlnIsExcelClipboard() As Boolean 
    Dim var As Variant 
    fctBlnIsExcelClipboard = False 
    'check if clipboard is in use 
    If mIntCutCopyMode = 0 Then Exit Function 
    'check if Excel data is in clipboard 
    For Each var In Application.ClipboardFormats 
     If var = xlClipboardFormatCSV Then 
      fctBlnIsExcelClipboard = True 
      Exit For 
     End If 
    Next var 
End Function