Microsoft Access 掲示板

VBAでコードの一括追加

6 コメント
views
4 フォロー

宜しくお願い致します。

VBAで、コードの文字の一括置き換えは出来ますが、一括追加は何らかの方法でできますか?

例)
Private Sub PI担当者ID_AfterUpdate()

    If Isnull(Me.PI担当者ID) = False Then

        Me.PI測定日 = Date

    End If

End Sub

置換のウインドウで、「PI担当者」を「Tan承認者」に置き換えることはできますが、
「End IF」の次の行に「Msgbox "日付を代入しました。", vbokonly」を追加することはできますか?

置換のウインドウで、
「検索する文字列」に「End IF」
「置換後の文字列」に
「End IF
Msgbox "日付を代入しました。", vbokonly」(改行しています)
とは入力できないので。

あん
作成: 2023/06/08 (木) 14:15:44
最終更新: 2023/06/08 (木) 14:16:22
通報 ...
1
hiroton 2023/06/08 (木) 17:11:35 dd05a@f966d

標準のエディタには無い機能なので、それができるエディタを使うとか、[F3][END][CTRL+v]を繰り返すとか、それをマクロで作るとか

あとは改行の代わりに:を使ってマルチステートメント記述にするとか

まぁ、コードの一括処理は余計なバグを生むこともありオススメしませんが

2

同じようなコードの置換、追加が多数必要になるということは、同じような処理が多数あるということですよね。

Private Sub PI担当者ID_AfterUpdate()

ということから推測すると、多数のコントロール(テキストボックス等)があり、そのコントロールで更新が発生したら、PI測定日を現在の日付を入力してメッセージボックスを表示させたい、
ということがご希望のことかと思えますがどうでしょうか。

こういう場合、共通の処理は一つのプロシージャにまとめておくと修正があっても一か所ですみます。

例えば下記のようなに。

Sub Ctrl_Update()
    If Isnull(Me.ActiveControl) = False Then
        Me.PI測定日 = Date
        Msgbox "日付を代入しました。", vbokonly '追加
    End If
End Sub

Private Sub PI担当者ID_AfterUpdate()
     Ctrl_Update
End Sub

Private Sub 他のコントロール_AfterUpdate()
     Ctrl_Update
End Sub

さらに共通処理の部分をFunctionにしておけば、

Function Ctrl_Update()
    If Isnull(Me.ActiveControl) = False Then
        Me.PI測定日 = Date
        Msgbox "日付を代入しました。", vbokonly '追加
    End If
End Function

デザインビューでこの処理を適用したいコントロールを複数選択しておいて「更新後処理」に

=Ctrl_Update()

とすれば、コントロール_AfterUpdate() のコードをコントロール数分記述する必要もなくなります。

同じような処理を複数個所に繰り返し記述するはバグの原因になりかねませんので、纏められるものはなるべつ纏めるというのがプログラミングの鉄則で。

3
あん 2023/06/09 (金) 15:22:39 927ea@06086

hiroton様、hatena様
ご回答ありがとうございます。

hiroton様の「コードの一括処理は余計なバグを生む」
hatena様の「纏められるものはなるべつ纏める」
勉強させていただきました。

今回、自分で試行錯誤しながら、VBAでVBAをコントロールするコードの記述ができました。

新規フォームに「実行」ボタン、「対象文字列」テキストボックス、「置換文字列」テキストボックスを配置し、
実行ボタンをクリックすると、全モジュールに対し、対象文字列を置換文字列に置き換える処理を行います。

4
あん 2023/06/09 (金) 15:28:43 927ea@06086
Private Sub 実行ボタン_Click()

    Dim vbcmp As VBComponent
    Dim Code As String 'モジュールのコードの文字列
    Dim CodeLine As String '置換したモジュールのコードを1行単位にした文字列
    Dim RowCount As Long 'モジュールの行数
    Dim i As Integer
    Dim j As Integer '置換モジュールの文字列の改行の開始位置
    Dim k As Integer '置換モジュールの文字列の改行の終了位置
    
    For Each vbcmp In Application.VBE.ActiveVBProject.VBComponents '全てのモジュールを1つ1つ処理
        
        Code = vbcmp.CodeModule.Lines(1, vbcmp.CodeModule.CountOfLines) 'モジュールのコードを文字列変数に代入
        
        Code = Replace(Code, Me.対象文字列, Me.置換文字列) 'モジュールのコードを置換した文字列を変数に代入
        
        RowCount = (Len(Code) - Len(Replace(Code, Chr13 & Chr10, ""))) / 2 + 1 '置換モジュールの行数
        vbcmp.CodeModule.DeleteLines 1, vbcmp.CodeModule.CountOfLines 'モジュールの全削除
        
        For i = 1 To RowCount '置換モジュールを1行1行モジュールに追加
                
            If i = 1 Then
            
                j = 0
                
            Else
                
                j = Min3(InStr(k + 1, Code, Chr13 & Chr10), InStr(k + 1, Code, Chr10), InStr(k + 1, Code, Chr13))
                
            End If
             
            k = Min3(InStr(j + 1, Code, Chr13 & Chr10), InStr(j + 1, Code, Chr10), InStr(j + 1, Code, Chr13))
            If k = 0 Then
             
                k = Len(Code) + 1
                
            End If
             
             
            CodeLine = Mid(Code, j + 1, k - j - 1)
            
            vbcmp.CodeModule.InsertLines i, CodeLine
        
        Next i
        
    Next vbcmp

End Sub

Min3に関しては、3つの数値の中で最小値が何かを算出する関数(ただし、0は除く)

Private Function Min3(a As Long, b As Long, c As Long) As Long

    If a <= b Then
    
        Min3 = a
        
        If Min3 = 0 Then
        
            Min3 = b
            
        End If
        
    Else
    
        Min3 = b
        
        If Min3 = 0 Then
        
            Min3 = a
            
        End If
        
    End If
    
    If c < Min3 And c > 0 Then
    
        Min3 = c
        
    End If

End Function

まだ、モジュール2つに対してのみ実行しただけなので、不完全でありますので、もっとテストしてみます。

ただ、hiroton様、hatena様の助言をいただきまして、実行するかよく考えなおしてみます。

5
あん 2023/06/09 (金) 15:30:52 927ea@06086

コメントアップ時にChr(13)とChr(10)でエラーが出たので、
Chr(13)→Chr13
Chr(10)→Chr10
としました。

6
あん 2023/06/12 (月) 10:01:04 927ea@06086

結局、VBAコードを一括変更は怖いので、1つ1つ変更していきます。
hatena様の「処理を纏める」ことを行なっていきたいと思います。