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

时间:2014-03-11 11:42:24

标签: 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

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

2 个答案:

答案 0 :(得分:10)

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

wb.Application.CutCopyMode = False

代替

Application.CutCopyMode = False

其中wb.Application返回工作簿wb所属的应用程序实例。

答案 1 :(得分:2)

45.2对我来说无法清除缓冲区或在尝试Application.CutCopyMode = False时停止出错。粘贴ActiveSheet。粘贴错误

清除产生errorActiveSheet的大缓冲区。例如,粘贴错误只是复制一个空单元格,例如ActiveSheet,其中单元格A1为空或非常小。这将使缓冲区真的很小!轻松修复!也许不完全正确,但功能正确。