Lightbox Info Board : SQLの窓

フォームに対して1つのテーブルをレコードソースとして連結し、編集操作を Access にまかせます。処理のコントロールは一定の仕様によってガチガチに固めてしまいましょう。まずプロパティや約束事は以下の通りです


' =========================================================
' 処理モードコンボボックス -> 2:更新,1:新規
'
' 作業ウィンドウを固定
' 規定のビュー  : 単票フォーム
' ビュー設定    : フォーム
' 自動中央寄せを行う
' 閉じるボタンは使用不能
' レコード移動ボタンは表示しない -> (SetStdFormで実行)
' 削除は通常不可 -> (SetStdFormで実行)
'
' キー項目が変更されたら更新モードにリセット
' 対象レコードが無い場合は Section 非表示
' 削除は通常不可にしておいて、更新時のみ解除する
' 数値の規定値プロパティへは 0 をセット
' 必要ならば、NULL 時にレコードへ 0 をセット(要コード)
' =========================================================

以下フォーム変数定義


Dim bUpdate
Dim ActType

以下　SetStdForm


' *********************************************************
' 標準フォームのプロパティ
' *********************************************************
Public Function SetStdForm(obj As Form) As Boolean

    obj.NavigationButtons = False       ' 移動ボタンを表示しない
    obj.AllowDeletions = False          ' 削除処理不能

End Function

プログラマが編集してはならないイベント


' *********************************************************
' 更新コントロール
' *********************************************************
Private Sub Form_BeforeUpdate(Cancel As Integer)

    ' 更新ボタンをクリックして更新確認した時のみ更新可能
    If Not bUpdate Then
        Cancel = True
    End If
     
    bUpdate = False
    
End Sub


' *********************************************************
' 削除更新
' *********************************************************
Private Sub btn削除_Click()

    ' -----------------------------------------------------
    ' 一時的に削除可能にする
    ' -----------------------------------------------------
    Me.AllowDeletions = True
    
    ' -----------------------------------------------------
    ' 削除実行
    ' -----------------------------------------------------
    If MsgBox("削除しますか?", vbOKCancel Or vbDefaultButton2 Or vbExclamation) = vbOK Then
        bUpdate = True
        On Error Resume Next
        DoCmd.RunCommand acCmdDeleteRecord
        If Err.Number <> 0 Then
            MsgBox (Err.Description)
        End If
        On Error GoTo 0
    End If
    
    ' -----------------------------------------------------
    ' 削除不能に戻す
    ' -----------------------------------------------------
    Me.AllowDeletions = False
    
    ' -----------------------------------------------------
    ' 現在のキーでリセット
    ' -----------------------------------------------------
    cmbコード_AfterUpdate

End Sub


' *********************************************************
' キャンセル処理
' *********************************************************
Private Sub btnキャンセル_Click()

    If Me.Dirty Then
        If MsgBox("編集をキャンセルしますか?", vbYesNo Or vbDefaultButton2) = vbYes Then
            Me.Undo
            Me.Refresh
        End If
    Else
        MsgBox ("編集されていません")
    End If
    
End Sub


' *********************************************************
' 終了
' *********************************************************
Private Sub btn終了_Click()

    DoCmd.Close , , acSaveNo

End Sub

プログラマが必要最低限編集するイベント


' *********************************************************
' 修正・新規更新
' *********************************************************
Private Sub btn更新_Click()
    
    Dim strKey1, strKey2
    
    If MsgBox("更新しますか?", vbOKCancel Or vbDefaultButton2 Or vbQuestion) = vbOK Then
        
        ' -------------------------------------------------
        ' 新規用事前処理 @@ 要変更
        ' -------------------------------------------------
        If cmb処理モード = 1 Then
            strKey1 = Me.cmbコード.Value
            Me.cmbコード.ControlSource = "資格コード"
            Me.cmbコード.Value = strKey1
        End If
    
        ' -------------------------------------------------
        ' 更新用編集 @@ 要変更
        ' -------------------------------------------------
        
        
        ' -------------------------------------------------
        ' 更新実行
        ' -------------------------------------------------
        bUpdate = True
        On Error Resume Next
        DoCmd.RunCommand acCmdSaveRecord
        If Err.Number <> 0 Then
            MsgBox (Err.Description)
        End If
        On Error GoTo 0
    
        ' -------------------------------------------------
        ' 新規用後処理
        ' -------------------------------------------------
        If Me.cmbコード.ControlSource <> "" Then
            Me.cmbコード.ControlSource = ""
        End If

        ' -----------------------------------------------------
        ' 現在のキーでリセット
        ' -----------------------------------------------------
        cmbコード_AfterUpdate
    
    End If

End Sub


' *********************************************************
' 新規モード移行
' *********************************************************
Private Sub btn新規レコード_Click()

    ' -----------------------------------------------------
    ' 処理モード変更
    ' -----------------------------------------------------
    Me.cmb処理モード.Value = 1

    ' -----------------------------------------------------
    ' ボタン状態のセット
    ' -----------------------------------------------------
    Me.Section(0).Visible = True
    Me.btn更新.Enabled = True
    Me.btnキャンセル.Enabled = True
    Me.btnキャンセル.SetFocus
    
    ' -----------------------------------------------------
    ' 新規レコード挿入は一度のみ
    ' -----------------------------------------------------
    Me.btn新規レコード.Enabled = False
    
    ' -----------------------------------------------------
    ' 新規レコード挿入
    ' -----------------------------------------------------
    On Error Resume Next
    DoCmd.RunCommand acCmdRecordsGoToNew
    On Error GoTo 0
        
    ' -----------------------------------------------------
    ' セクション内の内容をクリア
    ' -----------------------------------------------------
    For Each Target In Me.Section(0).Controls
        On Error Resume Next
        Target.Value = Empty
        On Error GoTo 0
    Next

    ' -----------------------------------------------------
    ' 初期値設定
    ' 新規レコードのデフォルト値を設定する
    ' -----------------------------------------------------
    
    
End Sub

プログラマが比較的編集する部分の多いイベント


' *********************************************************
' 初期処理
' *********************************************************
Private Sub Form_Load()

    DoCmd.SetWarnings (False)

    ' -----------------------------------------------------
    ' プログラム固有設定 @@ 要変更
    ' -----------------------------------------------------
    Me.タイトルラベル.Caption = "資格マスタメンテ"
    ActType = "全て"
'    ActType = "修正のみ"
'    ActType = "新規のみ"
'    ActType = "削除のみ"

    ' 表示専用フィールドの設定
    Call SetDispField(Me.txt名称)
    Call SetDispField(Me.txt名称2)
    
    ' -----------------------------------------------------
    ' 標準フォームプロパティ設定
    ' -----------------------------------------------------
    Call SetStdForm(Me)

    ' -----------------------------------------------------
    ' 更新可能フラグ OFF
    ' -----------------------------------------------------
    bUpdate = False
    
    ' -----------------------------------------------------
    ' フィルタ初期適用(レコード選択無し) @@ 要変更
    ' -----------------------------------------------------
    Me.FilterOn = False
    Me.Filter = "資格コード is NULL"
    Me.FilterOn = True
    
    ' -----------------------------------------------------
    ' 明細表示 OFF
    ' -----------------------------------------------------
    Me.Section(0).Visible = False
    
    ' -----------------------------------------------------
    ' ボタン初期状態
    ' -----------------------------------------------------
    If ActType = "修正のみ" Then
        Me.btn新規レコード.Visible = False
        Me.btn削除.Visible = False
    End If
    If ActType = "新規のみ" Then
        Me.btn削除.Visible = False
    End If
    If ActType = "削除のみ" Then
        Me.btn新規レコード.Visible = False
    End If
    
    Me.btn更新.Enabled = False
    Me.btnキャンセル.Enabled = False
    Me.btn終了.Enabled = True
    Me.btn新規レコード.Enabled = False
    Me.btn削除.Enabled = False
    
    ' -----------------------------------------------------
    ' 表示エリアクリア
    ' -----------------------------------------------------
    Me.txt名称.Value = ""
    Me.txt名称2.Value = ""
    
    ' -----------------------------------------------------
    ' 表示エリア非表示設定
    ' -----------------------------------------------------
    Me.lbl参照タイトル.Visible = False
    Me.cmb参照用.Visible = False
    Me.txt名称.Visible = False
    Me.txt名称2.Visible = False
'    Me.cmb処理モード.Visible = False

End Sub


' *********************************************************
' キー項目処理
' *********************************************************
Private Sub cmbコード_AfterUpdate()

    ' -----------------------------------------------------
    ' 表示書き換えのちらつき防止
    ' -----------------------------------------------------
    Me.Section(0).Visible = False
    
    ' -----------------------------------------------------
    ' キー変更は修正モードへ強制リセット
    ' -----------------------------------------------------
    Me.cmb処理モード.Value = 2
    
    ' -----------------------------------------------------
    ' 表示エリア設定  @@ 要変更
    ' -----------------------------------------------------
    Me.txt名称.Value = Me.cmbコード.Column(1)
    Me.cmb参照用.Value = ""

    ' -----------------------------------------------------
    ' 新規レコードボタン初期設定
    ' -----------------------------------------------------
    Me.btn新規レコード.Enabled = False
    
    If Not IsNull(Me.cmbコード.Value) Then
        ' -------------------------------------------------
        ' キーが入力されている場合  @@ 要変更
        ' -------------------------------------------------
        Me.Undo
        Me.FilterOn = False
        Me.Filter = "資格コード = " & Ss(Me.cmbコード.Value)
        Me.FilterOn = True
        
        Me.Section(0).Visible = IsRec(Me)
        Me.AllowAdditions = False
        If Not IsRec(Me) Then
            Me.AllowAdditions = True
            Me.btn新規レコード.Enabled = True
        End If
    Else
        ' -------------------------------------------------
        ' キーは未入力
        ' -------------------------------------------------
        Me.Section(0).Visible = False
    End If
    
    ' -----------------------------------------------------
    ' ボタン状態の同期
    ' -----------------------------------------------------
    Me.btn終了.SetFocus        ' 必ず使用可能なコントロール
    Me.btn更新.Enabled = Me.Section(0).Visible
    Me.btn削除.Enabled = Me.Section(0).Visible
    Me.btnキャンセル.Enabled = Me.Section(0).Visible

    ' -----------------------------------------------------
    ' 再表示
    ' -----------------------------------------------------
    Me.Refresh
    
    ' -----------------------------------------------------
    ' 更新ボタンへのフォーカス
    ' -----------------------------------------------------
    If Me.btn更新.Enabled Then
        Me.btn更新.SetFocus
    End If

End Sub

プログラム個別に必要なイベントサンプル


' *********************************************************
' リストに無い内容をコンボボックスで入力した場合
' *********************************************************
Private Sub cmb奨励対象区分_NotInList(NewData As String, Response As Integer)

    Me.cmb奨励対象区分.Undo

End Sub


' *********************************************************
' フォーカス
' *********************************************************
Private Sub cmb参照用_Enter()

    Me.cmb参照用.Dropdown

End Sub


' *********************************************************
' 参照用処理
' *********************************************************
Private Sub cmb参照用_AfterUpdate()
    
    ' -----------------------------------------------------
    ' 表示エリア設定
    ' -----------------------------------------------------
    Me.cmbコード.Value = Me.cmb参照用.Column(2)

    ' -----------------------------------------------------
    ' 再表示
    ' -----------------------------------------------------
    cmbコード_AfterUpdate

End Sub


' *********************************************************
' 入力チェック
' *********************************************************
Private Sub txt学生番号_BeforeUpdate(Cancel As Integer)

    If Not IsNumeric(Me.txt学生番号.Value) Then
        MsgBox ("数値を入力するか、ESC でキャンセルして下さい")
        Cancel = True
    End If

End Sub