複製範圍與VBA到剪貼板

Question

所以這就是我想要做的。我有一張表來解析快照之間的Cisco路由器接口錯誤，以便創建每個接口上有多少數據包和錯誤的摘要。我有一個按鈕綁定到一個宏執行此複製只是摘要本身。

x1 = Cells(2, 6).Value 
y1 = Cells(3, 6).Value 
x2 = Cells(4, 6).Value 
y2 = Cells(5, 6).Value 

ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Copy 

列出的每個單元格都具有要正確複製的節的行或列的值。 x2的單元格是根據多少個接口設置的，因此它可以更改所選範圍。

我的問題在於想要將此和最新的快照（它位於摘要部分正上方的單元格中）一起復制。我想在複製到剪貼板時將摘要理想地放在摘要下。爲此，我想我需要將範圍轉換爲一個字符串，然後將兩個字符串添加到剪貼板中。然而，我甚至無法將範圍轉換爲我可以放入剪貼板的東西。這是我使用的代碼，下面是在這裏找到的用於將範圍轉換爲字符串數組以及將字符串放入剪貼板的另一個代碼。然而，我不知道如何將字符串數組放入剪貼板，因爲它總是作爲'Object required'出錯。任何幫助，將不勝感激。

x1 = Cells(2, 6).Value 
y1 = Cells(3, 6).Value 
x2 = Cells(4, 6).Value 
y2 = Cells(5, 6).Value 
    ' Get values into a variant array 
Dim variantValues As Variant 
variantValues = ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Value 

' Set up a string array for them 
Dim stringValues() As String 
ReDim stringValues(1 To UBound(variantValues, 1), 1 To UBound(variantValues, 2)) 

' Put them in there! 
Dim columnCounter As Long, rowCounter As Long 
For rowCounter = UBound(variantValues, 1) To 1 Step -1 
    For columnCounter = UBound(variantValues, 2) To 1 Step -1 
     stringValues(rowCounter, columnCounter) = CStr(variantValues(rowCounter, columnCounter)) 
    Next columnCounter 
Next rowCounter 

' Return the string array 
RangetoStringArray = stringValues 

Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 
MSForms_DataObject.SetText RangetoStringArray.Value 
MSForms_DataObject.PutInClipboard 
Set MSForms_DataObject = Nothing 

Answer 1

我解決了它與Slai的技巧。

Sub CopyCompSnap() 

    x1 = Cells(2, 6).Value 
    y1 = Cells(3, 6).Value 
    x2 = Cells(4, 6).Value 
    y2 = Cells(5, 6).Value 

    Dim DataObj As MSForms.DataObject 
    Set DataObj = New MSForms.DataObject 

    ActiveSheet.Range(Cells(y1, x1), Cells(y2, x2)).Copy 
    DataObj.GetFromClipboard 
    On Error Resume Next 
    string1 = DataObj.GetText(1) 
    If Err.Number <> 0 Then 
     string1 = "Clipboard is Empty" 
    End If 
    ActiveSheet.Range("B5").Copy 
    DataObj.GetFromClipboard 
    On Error Resume Next 
    string2 = DataObj.GetText(1) 
    If Err.Number <> 0 Then 
     string2 = "Clipboard is Empty" 
    End If 
    strCopy = string1 & string2 
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 
    MSForms_DataObject.SetText strCopy 
    MSForms_DataObject.PutInClipboard 
    Set MSForms_DataObject = Nothing 

End Sub