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-現在、このアクションを実行できません

db全体をここからダウンロードできます。たった300KBです。レポートの名前は「rptObjList」です。「悪い」コードはコメントアウトされています。これはAccess2003データベースです。
ご協力いただきありがとうございます。

4

1 に答える 1

0

コードはフォームを開き、その.HasModuleプロパティをチェックします。フォームにモジュールがある場合は、そのモジュールを開いて確認し.CountOfLinesます。ただし、モジュールを開いてそのを判別する必要はありません.CountOfLines。そして、私もフォームを開かないようにします。

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

.CountOfLines次のような存在しないモジュールを要求した場合は、エラー＃9（「添え字が範囲外.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 に答える