Excel VBA:内存不足错误

时间:2016-03-18 16:06:41

标签: excel vba

我有两个.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出现在我的项目资源管理器中,工作表图标突出显示为蓝色。通常我只看到在项目浏览器中打开的工作簿。

enter image description here

以下是工作簿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

0 个答案:

没有答案