1

我尝试通过向模块和表单添加 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 - 您目前无法执行此操作

整个数据库可以在这里下载，它只有 300 KB。该报告名为“rptObjList”。“坏”代码已被注释掉。它是一个 Access 2003 数据库。
谢谢你的帮助。

4

1 回答 1

0

您的代码打开一个表单并检查其.HasModule属性。如果表单有模块，则打开该模块以检查.CountOfLines. 但是，您无需打开模块即可确定其.CountOfLines. 我也会尽量避免打开表格。

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

如果您要求.CountOfLines一个不存在的模块，如下所示，您可以捕获错误 #9 (' Subscript out of range ') 为您提供检查.HasModule属性的替代方法：

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

或者，您可以使用类似于ModuleExists()下面概述的最低限度测试的功能来检查代码模块。

注意我不确定我的建议会有多大帮助，因为我很难遵循您的代码。此外，当它调用没有属性的对象时，我不明智地选择单步执行后面的代码，rptObjList并对所有未处理的错误感到沮丧。我只是放弃了。GetDesc()Description

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
于 2012-12-07T18:40:41.167 回答