檢查表格的CountOfLines

Question

我嘗試通過向模塊和表單添加VBA行數來改進我對文檔數據庫所做的報告。以下代碼在標準模塊中完美工作：

Sub test() 
    Dim accObj As AccessObject, bwasOpen As Boolean, objName As String 
    objName = "Form1" 
    Set accObj = CurrentProject.AllForms(objName) 
    bwasOpen = accObj.IsLoaded 
    If Not bwasOpen Then 
     DoCmd.OpenForm objName, acDesign, WindowMode:=acHidden 
    End If 
    If Forms(objName).HasModule Then 
     DoCmd.OpenModule "Form_" & objName 
     Debug.Print Modules("Form_" & objName).CountOfLines 
    End If 
    If Not bwasOpen Then 
     DoCmd.Close acForm, objName, acSaveNo 
    End If 
End Sub 

但是，當我在報告本身中使用類似的代碼時，出現錯誤。而且，由於該錯誤發生在類模塊（報告）中，所以我感覺有點被卡住了。報告中的代碼：

Set accObj = CurrentProject.AllForms(objName) 
    bwasOpen = accObj.IsLoaded 
    If Not bwasOpen Then 
     DoCmd.OpenForm objName, acDesign, WindowMode:=acHidden 'Breaks here 
    End If 
    If Forms(objName).HasModule Then 
     DoCmd.OpenModule "Form_" & objName 
     GetExtraInfo = Modules("Form_" & objName).CountOfLines 
    End If 
    If Not bwasOpen Then 
     DoCmd.Close acForm, objName, acSaveNo 
    End If 

使用= GetExtraInfo（）從報告控件調用該代碼。整個事情運作良好，除了這個新的部分，我想返回CountOfLines的形式。

更新：我增加了一些錯誤捕獲，它給錯誤：
2486 - 你不能在目前的時間

整個數據庫可以下載here執行此操作，它的唯一的300 KB。該報告被命名爲「rptObjList」。 「壞」代碼已被註釋掉。它是一個Access 2003數據庫。
感謝您的幫助。

Answer 1

您的代碼打開一個表單並檢查其屬性.HasModule。如果表格有一個模塊，則打開該模塊以檢查.CountOfLines。但是，您無需打開模塊即可確定其.CountOfLines。我也會盡量避免打開表格。

? VBE.ActiveVBProject.VBComponents("Form_Form1").CodeModule.CountOfLines 
6 

如果請求.CountOfLines爲不存在的模塊，如以下，則可以捕獲誤差＃9（「下標超出範圍」）給你的替代檢查.HasModule屬性：

? VBE.ActiveVBProject.VBComponents("bogus").CodeModule.CountOfLines 

或者你可以檢查與類似功能的代碼模塊，以最小測試ModuleExists()概述如下。

注意我不確定我的建議有多大幫助，因爲我努力遵循您的代碼。此外，我不明智地選擇了通過rptObjList背後的代碼，並且因爲沒有Description屬性的對象調用GetDesc()而對所有未處理的錯誤感到沮喪。我只是放棄了。

Public Function ModuleExists(ByVal pModule As String, _ 
     Optional ByVal pProject As String = "") As Boolean 

    Dim blnReturn As Boolean 
    Dim objVBProject As Object 
    Dim strMsg As String 

On Error GoTo ErrorHandler 

    If Len(pProject) = 0 Then 
     Set objVBProject = VBE.ActiveVBProject 
    Else 
     Set objVBProject = VBE.VBProjects(pProject) 
    End If 
    blnReturn = Len(objVBProject.VBComponents(pModule).Name) > 0 

ExitHere: 
    Set objVBProject = Nothing 
    ModuleExists = blnReturn 
    Exit Function 

ErrorHandler: 
    Select Case Err.Number 
    Case 9 ' Subscript out of range 
     ' no such module; function returns False 
    Case Else 
     strMsg = "Error " & Err.Number & " (" & Err.Description _ 
      & ") in procedure ModuleExists" 
     MsgBox strMsg 
    End Select 
    GoTo ExitHere 
End Function