質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.23%

VBA コードを書く場所

受付中

回答 1

投稿

  • 評価
  • クリップ 0
  • VIEW 906

yuujiMotoki

score 33

最近、VBAでクラスモジュールを書くようになってから、
フォームでイベントハンドラさせたあとの、マクロの書き方に悩んでいます。

例えばですが

アクセスのデータベースにフォームボタンからイベント駆動する場合に
下記のような3階層のプログラムを書いています。

ユーザーフォームは、単なるイベントハンドラの受け場所にしており、
ほとんどソースを書かずに、標準モジュールに飛ばしています。

標準モジュールからwith 文を使って、クラスのインスタンスを生成して
あとはクラス内部に処理を書いています。

ただ、何をどう書くのかという決まりは持っておらず、
標準モジュールのコードはなるべく減らして、クラス側にもっていこうとはしています。

標準モジュールのオブジェクトは、毎回のイベント駆動で使っては消去しており、
ワークシート上へのデータ保持をしているような状態です。

いったん読みこんだデータソースなど、同じように何回も読みだすことに
実に不合理を感じています。

またフォーム上のコンボボックスの状態など、シートのセルに書き込んだりしていますが、
何か配列として、内部に置いておきたいと思っています(できればクラス変数として)

しかしながら、いまだにVBAのプログラムの組み方というものが
分かっておらず、何か無駄な感じがしてなりません。

何かこう、しっくりくるユーザーフォーム、標準モジュール、クラスモジュールの
使い方について指針というものはありませんでしょうか?

現状のソースコード

ユーザーフォーム

Private Sub CbtAccessOpen_Click()
access_db.アクセスを開く
End Sub

Private Sub CbtDelete_Click()
access_db.データ削除
End Sub

Private Sub CbtRefleshDB_Click()
access_db.更新
End Sub

Private Sub CbtRenew_Click()
access_db.データ追加更新
End Sub

Private Sub CommandButton4_Click()
access_db.リレーション構築
End Sub

access_db モジュール

Option Explicit

Sub 更新()
    With New clsAccessDB
    Set .WST = ActiveSheet
    .SQL_OPTION = FrmDbAccess.TextBox1
    .更新 Range("b2")
    .WST.Columns.AutoFit
    End With
End Sub

Sub データ追加更新()
    With New clsAccessDB
    Set .WST = ActiveSheet
    If TypeName(Selection) = "Range" Then
        Set .SetRange = Selection
        .データ追加更新
        MsgBox Selection.Address & "データを追加更新しました"
    End If
    End With
End Sub

Sub データ削除()
    With New clsAccessDB
    Set .WST = ActiveSheet
    If TypeName(Selection) = "Range" Then
        Set .SetRange = Selection
        .データ削除
        MsgBox Selection.Address & "データを削除しました"
    End If
    End With
End Sub

Sub アクセスを開く()
    With New clsAccessDB
    Set .WST = ActiveSheet
    .アプリを開く
    End With
End Sub

clsAccessDB

Option Explicit

Public WST As Worksheet  '対象とするワークシート
Public SQL_OPTION As String
Private datarow As Integer
Private dbPath As String
Private con As Object
Private mRS As Object
Private list_rows As Collection
Private table As Variant
Const dbFile As String = "MEP2019.accdb"
Private objrng As Variant

Private Sub DB切断()
    mRS.Close
    con.Close
    Set mRS = Nothing
    Set con = Nothing
End Sub

Public Sub 更新(Optional locate As Variant)
    If Not IsMissing(locate) Then
        Set objrng = locate
    End If

    DB接続
    DB読込
    DB切断
    TABLE作成
End Sub

Private Sub TABLE作成()
    On Error GoTo エラー処理
    With WST
    Set table = .ListObjects.Add(Source:=objrng.CurrentRegion)
    table.Name = .Name
    End With
    Exit Sub
エラー処理:
    MsgBox "テーブルは作成済みです。"
End Sub


Private Sub DB読込()  '引数にセル名
    Dim i
    With WST.ListObjects
    Do While .Count <> 0
    .Item(1).Delete
    Loop
    objrng.CurrentRegion.Clear
    End With
    With mRS
        For i = 0 To .Fields.Count - 1
            objrng.Offset(0, i).value = .Fields(i).Name
        Next i
    End With
    objrng.Offset(1, 0).CopyFromRecordset DATA:=mRS
End Sub

Public Sub データ追加更新()
    Dim i
    Dim data_r As Variant
    If Chk行選択 Then
        DB接続

        For Each data_r In list_rows
        With mRS
            .MoveFirst
            .Find Criteria:=.Fields(0).Name & "='" & WST.Cells(data_r, 1) & "'"
            If .EOF = True Then
            .AddNew
        End If
        For i = 1 To .Fields.Count - 1
            .Fields(i).value = WST.Cells(data_r, i + 1).value
        Next i
        .Update
        .MoveFirst
        End With
    Next
    DB読込
    DB切断
    End If
End Sub

Private Function Chk行選択() As Boolean
    If list_rows Is Nothing Then
        MsgBox "行が選ばれていません"
        Chk行選択 = False
        Exit Function
    End If
    If MsgBox("行" & list_rows(1) & "から" & list_rows.Count & "個のデータを処理しますか?", vbOKCancel) = vbOK Then
        Chk行選択 = True
    Else
        Chk行選択 = False
    End If
End Function

Public Sub データ削除()
    Dim i
    Dim data_r As Variant
    If Chk行選択 Then
        DB接続
    For Each data_r In list_rows
        With mRS
        .MoveFirst
        .Find Criteria:=.Fields(0).Name & "='" & Cells(data_r, 1).value & "'"
        If .EOF = True Then
            MsgBox "該当するレコードは存在しません。"
            DB切断
            Exit Sub
        End If
        .Delete
        .MoveFirst
        End With
    Next
    DB読込
    DB切断
  End If
End Sub

Private Sub DB接続()
    Dim SQL As String
    Dim sheetname As Variant
    Dim i As Integer
    Dim TableName As String
        'SQL_OPTION = FrmDbAccess.TextBox1
    TableName = WST.Name        'シート名が、そのままACCESSテーブル名にリンクする
    Set con = CreateObject("ADODB.Connection")
    con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & dbPath & dbFile
    con.Open
    Set mRS = CreateObject("ADODB.Recordset")
    SQL = "SELECT * FROM " & TableName & " " & SQL_OPTION  'クエリ検索オプションを指定して、SQL読込をする
    'MsgBox SQL
    mRS.Open SQL, con, adOpenKeyset, adLockOptimistic, adLockReadOnly
End Sub

Property Get RelationTBL() As Variant
'Set RelationTBL = Sheets(RelTBL)
End Property

Property Set SetRange(ByVal rngs As Variant)
    Dim list_ As New Collection
    Dim rng As Variant
    For Each rng In rngs
        list_.Add rng.row
    Next
    Set list_rows = list_
End Property

Private Sub Class_Initialize()
    Set WST = ActiveSheet
    Set objrng = Range("a1") 'default origin location
    dbPath = ActiveWorkbook.Path & "\..\"
End Sub

Private Sub Class_Terminate()
    'MsgBox ("データベースを閉じました")
End Sub

Public Sub アプリを開く()   'ACCESSを起動する
    With CreateObject("Access.Application")
        .OpenCurrentDatabase dbPath & dbFile
        .DoCmd.OpenTable ActiveSheet.Name, acNormal
        .Visible = True
        .UserControl = True
    End With
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

0

クラスモジュール、標準モジュール、イベントプロシージャの使い分けの標準が、
もし、社内(個人でも良いと思います)にあるのであれば、それに従うのが普通です。

Accessとなると、業務用で使用されるアプリが多いと思います。
その場合、処理速度よりメンテナンス性が重要になり、そのメンテナンス性とは、わかりやすさです。

自分の場合、ある程度の使用ルールを決めています。

クラスモジュールの場合
クラスモジュールのメリットの一番は、データとメソッドが一体化でき、そのインスタンスを開放しない限りデータを保持できる点です。
Accessの場合、データの検索系の処理で役に立つ場合が多いです。
あるキーを渡したら、関連のデータを取得し、パラメータ値としていつでも渡す準備が出来る点。
また、アプリの基本機能としても有効だと思います。
例えば、経過時間の計算、レジストリの更新、ファイル操作などで、アプリの内容に左右されない場合ですね。
自分の場合。クラスモジュールは、一種の変数(レコード)として取り扱っている場合が多いです。

標準モジュールの場合
標準モジュールの一番のメリットは、フォームやクエリで、ユーザー定義関数として扱える点です。
ある特定の値を返す関数や決まりきった処理を行う時や、クエリ、フォーム、レポート等で、Excelのワークシート関数の様に使える点です。
これは、クラスモジュールでは実装できない点でもあります。
ある1つのフォーム内にテキストボックスが複数あり、同じ処理をする場合、イベントプロシージャに関数名を指定すると、同じコードを書く必要が無くなります。
自分の場合、一種の関数として使用しています。

イベントプロシージャの場合
自分の場合、ほとんどイベントプロシージャで済ませる場合が多いです。
それでも、共通する機能は、標準モジュールを使ったり、クラスを扱いますが、結局、メンテナンスは、オブジェクト単位で行う場合が多く、もし、標準モジュールにしていたら、他のオブジェクトに影響が出る可能性があります。
もし、他のオブジェクトに使用されていれば、使われているオブジェクトに対してもテストをする羽目になります。

ソースコードを見ましたが、ちょっと、標準モジュールとクラスモジュールに頼り過ぎだと思います。
クラスモジュールですが、プロパティを増やすと、共通化できると思います。
ただし、プロパティを増やし過ぎると、クラスとしてのメリットが無くなるので、やり過ぎと評価しました。

長くなりましたが、結局のところ、ルールは自分で作ることになるので、自分のポリシーを強く持って、コードを書いて下さいと言いたいです。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.23%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる