我有两个.xlsm工作簿。只有工作簿B在另一个上运行宏。
Workbook A: Job Closeout Status.xlsm
Workbook B: Weekly Payment Sheet.xlsm
工作簿B有一个数据透视表,数据源是工作簿A. wkbk B上的宏在打开时刷新数据透视表。
我收到内存不足错误。我研究过我应该把对象设置为空。但是我无法编辑宏。每次我尝试添加一行代码时,都会出现“内存不足”错误。任何人都可以帮我解决如何优化性能,并解决这个“内存不足”的问题吗?感谢。
我还注意到在Visual Basics App中,当我只打开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