0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

他者が作ったAccessツールを改修する時に何かと重宝するモジュール

Last updated at Posted at 2025-07-19

Excel や Acces で作成された、いわゆるVBAツールは、要件定義書、仕様書、設計書、マニュアル等のドキュメント類が「何それ?美味しいの?」状態の場合が多い。
とにかく、テーブル(およびそのフィールド)名、フォーム(およびその部品(コントロール))名、クエリ、プロシージャなどの一覧リストをテキスト出力しておくこと。
それらをExcelのシートなどに貼り付けて全体のおおまかな仕様を管理しやすくすることが大事。

Access_Name_Module.bas
' <参照設定>
' [Microsoft Visual Basic for Applications Extensibility]

Option Compare Database
Option Explicit

'// 与えられた文字列(tgt_str)を、半角スペースパディングした n_byte バイトの固定長文字列にして返す

Function FixedStrB(ByVal tgt_str As String, ByVal n_byte As Long) As String

    FixedStrB = StrConv(LeftB(StrConv(tgt_str & Space(n_byte), vbFromUnicode), n_byte), vbUnicode)

End Function
'// テーブル名一覧を返す

Function GetTableList()

    Dim tdf     As TableDef
    Dim tdfName As String
    Dim tblList As String
    Dim n       As Long
    
    For Each tdf In CurrentDb.TableDefs
        tdfName = tdf.Name
        If Left(tdfName, 4) <> "MSys" Then
            n = n + 1
            Debug.Print Format(n, "@@@@"); " |"; tdfName
            tblList = tblList & vbCrLf & tdfName
        End If
    Next tdf
    
    GetTableList = tblList

End Function
'// フォーム名一覧を返す

Function GetFormList()

    Dim frm
    Dim frmList As String
    Dim n       As Long
    
    For Each frm In CurrentProject.AllForms
        n = n + 1
        Debug.Print Format(n, "@@@@"); " |"; frm.Name
        frmList = frmList & vbCrLf & frm.Name
    Next frm
    
    GetFormList = frmList

End Function
'// クエリ名一覧を返す

Function GetQueryList()

    Dim qry     As QueryDef
    Dim qryName As String
    Dim qryList As String
    Dim n       As Long
    
    For Each qry In CurrentDb.QueryDefs
        qryName = qry.Name
        If Left(qryName, 4) <> "~sq_" Then
            n = n + 1
            Debug.Print Format(n, "@@@@"); " |"; qryName
            qryList = qryList & vbCrLf & qry.Name
        End If
    Next qry
    
    GetQueryList = qryList

End Function
'// レポート一覧を返す

Function GetReportList()

    Dim rprt
    Dim rprtList As String
    Dim n        As Long
    
    For Each rprt In CurrentProject.AllReports
        n = n + 1
        Debug.Print Format(n, "@@@@"); " |"; rprt.Name
        rprtList = rprtList & vbCrLf & rprt.Name
    Next rprt
    
    GetReportList = rprtList

End Function
'// テーブル(table_name)のフィールド名一覧を返す

Function GetFieldNameList(ByVal table_name As String)

    Dim db As DAO.Database: Set db = CurrentDb
    
    Dim fld         As DAO.Field
    Dim fldNameList As String
    Dim n           As Long
    
    For Each fld In db.TableDefs(table_name).Fields
        Debug.Print Format(n, "@@@@"); " |"; fld.Name
        fldNameList = fldNameList & fld.Name & vbCrLf
    Next fld

    Set db = Nothing   
    
    GetFieldNameList = fldNameList

End Function
'// フォーム(form_name)に配置されているコントロール名一覧を返す

Function GetControlNameList(ByVal form_name As String)

    Dim ctrl         As Control
    Dim ctrlNameList As String
    Dim n            As Long
     
    For Each ctrl In Forms(form_name).Controls
        n = n + 1
        Debug.Print Format(n, "@@@@"); " |"; _
                    ctrl.ControlType; " |"; _
                    FixedStrB(TypeName(ctrl), 15); " |"; _
                    ctrl.Name
        ctrlNameList = ctrlNameList & ctrl.Name & vbCrLf
    Next ctrl
    
    GetControlNameList = ctrlNameList
    
End Function
'// モジュール一覧を返す

Function GetModuleList()

    Dim mdl
    Dim mdlList As String
    Dim n       As Long
    
    For Each mdl In CurrentProject.AllModules
        n = n + 1
        Debug.Print Format(n, "@@@@"); " |"; mdl.Name
        mdlList = mdlList & mdl.Name & vbCrLf
    Next mdl
    
    GetModuleList = mdlList
    
End Function
'// フォームモジュール名一覧を返す

Function GetFormModulesList()

    Dim vbComp     As VBComponent
    Dim frmMdlList As String
    Dim n          As Long
    
    For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
        If vbComp.Type = vbext_ct_Document Then
            n = n + 1
            Debug.Print Format(n, "@@@@"); " |"; _
                        FixedStrB(vbComp.Name, 20); " |"; _
                        vbComp.Type
            frmMdlList = frmMdlList & vbComp.Name & vbCrLf
        End If
    Next
    
    GetFormModulesList = frmMdlList
    
End Function
'// プロシージャの一覧を返す

Function GetProcedureList()

    Dim vbComp   As VBComponent
    Dim codeMod  As CodeModule
    Dim procKind As vbext_ProcKind
    Dim procName As String
    Dim procList As String
    Dim lineNum  As Long
    Dim n        As Long
    
    Debug.Print FixedStrB("No.", 4); " |"; _
                FixedStrB("モジュール名", 20); " |"; _
                "プロシージャ名"

    For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
        Set codeMod = vbComp.CodeModule
        lineNum = 1
        Do While lineNum < codeMod.CountOfLines
            procName = codeMod.ProcOfLine(lineNum, procKind)
            If procName <> "" Then
                n = n + 1
                Debug.Print Format(n, "@@@@"); " |"; _
                            FixedStrB(vbComp.Name, 20); " |"; _
                            procName
                procList = procList & vbCrLf & vbComp.Name & "." & procName
                lineNum = lineNum + codeMod.ProcCountLines(procName, procKind)
            Else
                lineNum = lineNum + 1
            End If
        Loop
    Next vbComp

    Set codeMod = Nothing
    
    GetProcedureList = procList
    
End Function

<参考サイト>
LeftB関数:文字列の左から指定のバイト数分だけ文字列を取得する

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?