Accessのフォーム/レポート内のラベルのキャプションをテキストに一括出力するモジュール

投稿者: | 2020/04/03

Accessのフォーム/レポートにあるラベルの内容を一括でテキストに出力するモジュールです。

ラベルで表示してる項目名変えるんだけどどこに何があるか調べきれない、とか、そんなときに使えます。

出力されるテキストファイルはAccessのファイルを同じ場所に作られます。同じファイル名がある時は追記します。

お約束ですが、使用前に念の為バックアップを取ってください。このコードを使用して発生した諸々の事態には責任が持てませんので自己責任でお使いください。

フォームのラベルを一括出力

Sub form_label_caption_out()

On Error Resume Next
    
    Dim frm     As AccessObject
    Dim ctl     As Control
    
    'ファイル出力用
    Dim FSO
    Dim LOG
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'ファイルがなければ新規作成
    If FSO.FileExists(CurrentProject.Path & "\formlabel.txt") = False Then
        FSO.CreateTextFile CurrentProject.Path & "\formlabel.txt"
    End If
    
    Set LOG = FSO.OpenTextFile(CurrentProject.Path & "\formlabel.txt", 8)
    
    '全てのフォームで繰り返す
    For Each frm In Application.CurrentProject.AllForms
    
        'フォームをデザインビューで開く
        DoCmd.OpenForm frm.Name, acDesign, , , , acHidden
        
        For Each ctl In Forms(frm.Name).Controls
            If ctl.ControlType = acLabel Then
    
                '書き込み
                LOG.WriteLine frm.Name & Chr(9) & ctl.Name & Chr(9) & ctl.Caption

            End If
         
        Next ctl

        'フォームを閉じる
        DoCmd.Close acForm, frm.Name, acSaveNo
    
    Next frm

    Set FSO = Nothing
    Set LOG = Nothing

End Sub

レポートのラベルを一括出力

Sub report_label_caption_out()

On Error Resume Next
    
    Dim rep As AccessObject
    Dim ctl As Control
    
    'ファイル出力用
    Dim FSO
    Dim LOG
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    'ファイルがなければ新規作成
    If FSO.FileExists(CurrentProject.Path & "\reportlabel.txt") = False Then
        FSO.CreateTextFile CurrentProject.Path & "\reportlabel.txt"
    End If
    
    Set LOG = FSO.OpenTextFile(CurrentProject.Path & "\reportlabel.txt", 8)
    
    '全てのレポートで繰り返す
    For Each rep In Application.CurrentProject.AllReports
    
        'レポートをデザインビューで開く
        DoCmd.OpenReport rep.Name, acDesign, , , , acHidden
        
        For Each ctl In Reports(rep.Name).Controls
            If ctl.ControlType = acLabel Then
    
                '書き込み
                LOG.WriteLine rep.Name & Chr(9) & ctl.Name & Chr(9) & ctl.Caption

            End If
         
        Next ctl

        'レポートを閉じる
        DoCmd.Close acReport, rep.Name, acSaveNo
    
    Next rep

    Set FSO = Nothing
    Set LOG = Nothing

End Sub


コメントを残す

メールアドレスが公開されることはありません。