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

【问题标题】：Copy Range with VBA to clipboard使用 VBA 将范围复制到剪贴板
【发布时间】：2017-03-19 10:24:12
【问题描述】：

这就是我想要做的。我有一张表格来解析快照之间的 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

【问题讨论】：

您可以Range.Copy 并从剪贴板中的字符串变量中获取文本。下一个范围相同，连接两个结果，然后放入剪贴板。
@Slai Wow 这很有效，而且要容易得多。看起来我只是让自己的事情变得更复杂！非常感谢

标签： vba excel

【解决方案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

【讨论】：