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 

我想我会通过closuresRAW数据工作簿(我想这样做),但我得到一个提示,因为剪贴板数据是相当大的,所以这也是行不通的。

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

 wb.Application.CutCopyMode = False 

代替

 Application.CutCopyMode = False 

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

我所做的只是复制了我的ActiveWorkbook中的任何空白单元格,一旦我粘贴了我之前复制的值,而且我不再需要它们,并且这会用一个空stringreplace剪贴板中的大数据(相对而言)允许我在需要时closures工作簿。

我知道这是一个解决方法,但它一直工作。

另一个scheme

你应该尝试的是得到MSForms DataObject并尝试把它放在剪贴板

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

然后将其清除如下:

 clipboard.Clear 

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

 clipboard.SetText "" clipboard.PutInClipboard 

Application.CutCopyMode = False对我来说无法清除缓冲区,或者在尝试使用ActiveSheet时不会出现错误。 粘贴errorActiveSheet 。 粘贴错误

清除一个大的缓冲区,生成一个ActiveSheet 。例如,粘贴错误是复制一个空单元格,例如Range("A1").Copy ,其中单元格A1将是空的或非常小的。 这将使缓冲区真的很小! 轻松修复! 也许不完全正确,但在function上是正确的。