Excel VBA - 如何在另一个应用程序中清除另一个工作簿上的剪贴板?

Pet*_*y87 6 excel vba excel-vba

背景:

我有一个脚本,它正在格式化原始数据并将其附加到我打开的分析工作簿的末尾.该脚本从分析工作簿运行,因为每次都会填充RAW数据.

问题:

该脚本工作正常,有一个例外,我无法清除其他工作簿上的剪贴板,我怀疑这是由于它在Excel的另一个实例(应用程序)中打开.

我的代码到目前为止:

Sub Data_Ready_For_Transfer()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rnglog As Range
    Dim lastrow As Range
    Dim logrange As Range
    Dim vlastrow As Range
    Dim vlastcol As Range
    Dim copydata As Range
    Dim pastecell As Range
    Dim callno As Range

    Set wb = GetObject("Book1")
    Set ws = wb.Worksheets("Sheet1")

    Application.ScreenUpdating = False

    'if we get workbook instance then
    If Not wb Is Nothing Then
        With wb.Worksheets("Sheet1")
            DisplayAlerts = False
            ScreenUpdating = False
            .Cells.RowHeight = 15
            Set rnglog = wb.Worksheets("Sheet1").Range("1:1").Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
            Set lastrow = rnglog.EntireColumn.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set logrange = wb.Worksheets("Sheet1").Range(rnglog, lastrow)
            rnglog.EntireColumn.Offset(0, 1).Insert
            rnglog.EntireColumn.Offset(0, 1).Insert
            rnglog.EntireColumn.Offset(0, 1).Insert
            rnglog.EntireColumn.TextToColumns Destination:=rnglog, DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                :=Array(Array(1, 1), Array(2, 1), Array(3, 9)), TrailingMinusNumbers:=True
            rnglog.Value = "Log Date"
            rnglog.Offset(0, 1).Value = "Time"
            logrange.Offset(0, 2).FormulaR1C1 = "=WEEKNUM(RC[-2])"
            logrange.Offset(0, 2).EntireColumn.NumberFormat = "General"
            rnglog.Offset(0, 2).Value = "Week Number"
            logrange.Offset(0, 3).FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")"
            logrange.Offset(0, 3).EntireColumn.NumberFormat = "General"
            rnglog.Offset(0, 3).Value = "Month"
            Set vlastrow = wb.Worksheets("Sheet1").Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set vlastcol = vlastrow.EntireRow.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
            Set copydata = .Range("A2", vlastcol)
            copydata.Copy
        End With
        With ActiveWorkbook.Worksheets("RAW Data")
            Set pastecell = .Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
            Set callno = .Range("1:1").Find(What:="Call No", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
            pastecell.Offset(1, 0).PasteSpecial xlPasteValues
            .Cells.RemoveDuplicates Columns:=5, Header:=xlYes
            Application.CutCopyMode = False
        End With
        wb.Close False
        Application.ScreenUpdating = True
        MsgBox "Done"
    End If
End Sub
Run Code Online (Sandbox Code Playgroud)

我以为我会通过关闭RAW Data工作簿来解决这个问题(我还是想这样做)但是我得到一个提示,因为剪贴板数据相当大,所以这也行不通.

Dmi*_*liv 11

由于工作簿wb属于另一个应用程序实例,因此您应该使用

wb.Application.CutCopyMode = False
Run Code Online (Sandbox Code Playgroud)

代替

Application.CutCopyMode = False
Run Code Online (Sandbox Code Playgroud)

其中,wb.Application返回该工作簿的应用实例wb属于.


AKS*_*AKS 5

我要做的就是在粘贴了先前复制的值之后就复制了ActiveWorkbook中的任何空白单元格,而我不再需要它们了-这会将剪贴板中的大数据替换为空字符串(相对而言没有),并且允许我在需要时关闭工作簿。

我知道这是一种解决方法,但它始终有效。

另一种解决方案

您应该尝试获取MSForms DataObject并将其放入剪贴板

Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
Run Code Online (Sandbox Code Playgroud)

然后清除它,如下所示:

clipboard.Clear
Run Code Online (Sandbox Code Playgroud)

如果这不起作用,您可以始终将剪贴板文本设置为空

clipboard.SetText ""
clipboard.PutInClipboard
Run Code Online (Sandbox Code Playgroud)