使用VBA将范围复制到剪贴板

时间:2016-11-05 19:04:06

标签: excel vba excel-vba

所以这就是我想要做的。我有一张工作表来解析快照之间的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的单元格根据接口数量设置,以便更改所选范围。

我的问题在于想要将这个和最新的快照(位于摘要部分正上方的单元格中)一起复制。我想在复制到剪贴板时理想地将快照放在摘要下。要做到这一点,我想我需要将范围转换为字符串,然后将两个字符串一起添加到剪贴板中。但是我甚至无法将范围转换为我可以放在剪贴板中的东西。这是我在下面使用的代码,用于将范围转换为字符串数组,另一个用于将字符串放入剪贴板。但是我无法弄清楚如何将字符串数组放入剪贴板,因为它总是错误地显示为“对象需要”。任何帮助将不胜感激。

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

1 个答案:

答案 0 :(得分:0)

我用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