Excel VBA:内存不足错误

我有两个.xlsm工作簿。 只有工作簿B在另一个上运行一个macros。

Workbook A: Job Closeout Status.xlsm Workbook B: Weekly Payment Sheet.xlsm 

工作簿B有一个数据透视表,其中数据源是工作簿A. wkbk B上的macros在打开时刷新数据透视表。

我得到一个内存不足的错误。 我研究过,我应该把对象设置为无。 但是我不能编辑macros。 每次我尝试添加一行代码时,都会显示“内存不足”错误。 任何人都可以帮助我如何优化性能,并解决这个“内存不足”的问题? 谢谢。

我也注意到,在Visual Basic应用程序,当我只有wkbk B打开,wkbk A出现在我的项目浏览器和工作表图标高亮显示蓝色。 通常我只能看到在项目浏览器中打开的工作簿。

在这里输入图像说明

这是我在工作簿B中的代码:

在ThisWorkbook模块中:

 Option Explicit Private Sub Workbook_Open() ThisWorkbook.Worksheets("RETENTION").Unprotect Application.ScreenUpdating = False Application.DisplayAlerts = False Dim wkb As Workbook On Error Resume Next If IsFileOpen("S:\ACCOUNTING\Subcontracts\Job Closeout Tracking\Job Closeout Status.xlsm") Then GoTo Protect Else On Error Resume Next Set wkb = Workbooks.Open(filename:="S:\ACCOUNTING\Subcontracts\Job Closeout Tracking\Job Closeout Status.xlsm") ThisWorkbook.RefreshAll wkb.Close SaveChanges:=False End If Protect: ThisWorkbook.Worksheets("RETENTION").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=True Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

在一个单独的模块中:

 Function IsFileOpen(filename As String) Dim filenum As Integer, errnum As Integer On Error Resume Next ' Turn error checking off. filenum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. Open filename For Input Lock Read As #filenum Close filenum ' Close the file. errnum = Err ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. Select Case errnum ' No error occurred. ' File is NOT already open by another user. Case 0 IsFileOpen = False ' Error number for "Permission Denied." ' File is already opened by another user. Case 70 IsFileOpen = True ' Another error occurred. Case Else Error errnum End Select End Function