| 対象テーブルと主キーの情報による標準化 (変更対象部分) --> キーがひとつの場合 |
|
| |
Dim bUpdate
Dim ActType
Dim strTarget
Dim strPkey1, nPkeyType, nPkeySize
| |
|
| |
' *********************************************************
' コード編集 ( サンプル )
' *********************************************************
Private Sub cmbコード_LostFocus()
' cmbコード が 前ゼロ編集の場合は、以下の False を True に変更します
If False Then
If Not IsNull(Me.cmbコード.Value) Then
Me.cmbコード.Value = _
Right("000000000000" & Me.cmbコード.Value, nPkeySize)
End If
End If
End Sub
' *********************************************************
' コードの桁数チェック ( サンプル )
' *********************************************************
Private Sub cmbコード_BeforeUpdate(Cancel As Integer)
Dim nCurDataLength
' 文字列の時は、DB の定義から長さを取得してチェック
If nPkeyType = 10 Then
nCurDataLength = LenB(StrConv(Me.cmbコード.Value, vbFromUnicode))
If nCurDataLength > nPkeySize Then
MsgBox ("入力されたデータのサイズが大きすぎます ( " _
& nTargetFieldSize & "桁以内 )")
Cancel = True
Exit Sub
End If
Else
' 文字列以外の場合は、仕様に基づいてチェックします
End If
End Sub
' *********************************************************
' 初期処理
' *********************************************************
Private Sub Form_Load()
' -----------------------------------------------------
' 対象テーブルと主キーの情報
' ★ 設定して下さい
' -----------------------------------------------------
strTarget = "コード区分マスタ"
strPkey1 = "区分"
' -----------------------------------------------------
' タイプとサイズの自動取得
' -----------------------------------------------------
nPkeyType = _
Application.CurrentDb.TableDefs(strTarget).Fields(strPkey1).Type
nPkeySize = _
Application.CurrentDb.TableDefs(strTarget).Fields(strPkey1).Size
DoCmd.SetWarnings (False)
' -----------------------------------------------------
' プログラム固有設定
' ★ 処理モード限定時のみ ActType を変更します
' -----------------------------------------------------
Me.タイトルラベル.Caption = strTarget & "メンテ"
ActType = "全て"
' ActType = "修正のみ"
' ActType = "新規のみ"
' ActType = "削除のみ"
' -----------------------------------------------------
' 表示専用フィールドの設定
' -----------------------------------------------------
Call SetDispField(Me.txt名称)
Call SetDispField(Me.txt名称2)
' -----------------------------------------------------
' 標準フォームプロパティ設定
' -----------------------------------------------------
Call SetStdForm(Me)
' -----------------------------------------------------
' 更新可能フラグ OFF
' -----------------------------------------------------
bUpdate = False
' -----------------------------------------------------
' フィルタ初期適用(レコード選択無し)
' -----------------------------------------------------
Me.FilterOn = False
Me.Filter = strPkey1 & " 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.cmb処理モード.Visible = True ' 処理区分
Me.txt名称.Visible = False ' コード名称用
Me.lbl参照タイトル.Visible = False ' 参照用タイトルラベル
Me.cmb参照用.Visible = False ' 参照用コンボ
Me.txt名称2.Visible = False ' 参照用名称表示
Me.cmbコード.SetFocus
End Sub
' *********************************************************
' キー項目処理
' *********************************************************
Private Sub cmbコード_AfterUpdate()
' -----------------------------------------------------
' 表示書き換えのちらつき防止
' -----------------------------------------------------
Me.Section(0).Visible = False
' -----------------------------------------------------
' キー変更は修正モードへ強制リセット
' -----------------------------------------------------
Me.cmb処理モード.Value = 2
' -----------------------------------------------------
' 表示エリア設定
' ★ コードの名称を表示する場合
' -----------------------------------------------------
On Error Resume Next
Me.txt名称.Value = Me.cmbコード.Column(1)
On Error GoTo 0
Me.cmb参照用.Value = ""
' -----------------------------------------------------
' 新規レコードボタン初期設定
' -----------------------------------------------------
Me.btn新規レコード.Enabled = False
If Not IsNull(Me.cmbコード.Value) Then
' -------------------------------------------------
' キーが入力されている場合
' ★ 入力されたキー値の設定ですが、通常は変更
' ★ の必要はありません
' -------------------------------------------------
Me.Undo
Me.FilterOn = False
If nPkeyType <> 4 Then
Me.Filter = strPkey1 & " = " & Ss(Me.cmbコード.Value)
Else
Me.Filter = strPkey1 & " = " & Me.cmbコード.Value
End If
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 btn更新_Click()
Dim strKey1, strKey2
If MsgBox("更新しますか?", _
vbOKCancel Or vbDefaultButton2 Or vbQuestion) = vbOK Then
' -------------------------------------------------
' 新規用事前処理
' ★ 新規の場合、キー項目に直接セット
' ★ 新規の時のみ設定する項目のセット
' -------------------------------------------------
If cmb処理モード = 1 Then
Me.区分.Value = Me.cmbコード.Value
End If
' -------------------------------------------------
' 作成日と更新日がある場合にシステム日付をセット
' -------------------------------------------------
On Error Resume Next
If cmb処理モード = 1 Then
Me.作成日.Value = Date
Me.更新日.Value = Date
End If
If cmb処理モード = 2 Then
Me.更新日.Value = Date
End If
On Error GoTo 0
' -------------------------------------------------
' 更新用編集
' ★ 特殊な編集が必要な場合に記述します
' -------------------------------------------------
' -------------------------------------------------
' 更新実行
' -------------------------------------------------
bUpdate = True
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
If Err.Number <> 0 Then
MsgBox (Err.Description)
End If
On Error GoTo 0
' -----------------------------------------------------
' 現在のキーでリセット
' -----------------------------------------------------
cmbコード_AfterUpdate
End If
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 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()
' -----------------------------------------------------
' 処理モード変更
' -----------------------------------------------------
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 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 Form_BeforeUpdate(Cancel As Integer)
' 更新ボタンをクリックして更新確認した時のみ更新可能
If Not bUpdate Then
Cancel = True
End If
bUpdate = False
End Sub
| |
|
|
| 対象テーブルと主キーの情報による標準化 (変更対象部分) --> キーが複数の場合 |
|
| |
Dim bUpdate
Dim ActType
Dim strTarget
Dim strPkey1, strPkey2, nPkeyType
| |
|
| |
' *********************************************************
' 初期処理
' *********************************************************
Private Sub Form_Load()
' -----------------------------------------------------
' 対象テーブルと主キーの情報
' ★ 設定して下さい
' -----------------------------------------------------
strTarget = "コード名称マスタ"
strPkey1 = "区分"
strPkey2 = "コード"
' -----------------------------------------------------
' タイプとサイズの自動取得は、キー列が複数なのでしません
' -----------------------------------------------------
DoCmd.SetWarnings (False)
' -----------------------------------------------------
' プログラム固有設定 @@ 要変更
' ★ 処理モード限定時のみ ActType を変更します
' -----------------------------------------------------
Me.タイトルラベル.Caption = strTarget & "メンテ"
ActType = "全て"
' ActType = "修正のみ"
' ActType = "新規のみ"
' ActType = "削除のみ"
' -----------------------------------------------------
' 表示専用フィールドの設定
' -----------------------------------------------------
Call SetDispField(Me.txt名称)
Call SetDispField(Me.txt名称2)
' -----------------------------------------------------
' 標準フォームプロパティ設定
' -----------------------------------------------------
Call SetStdForm(Me)
' -----------------------------------------------------
' 更新可能フラグ OFF
' -----------------------------------------------------
bUpdate = False
' -----------------------------------------------------
' フィルタ初期適用(レコード選択無し)
' -----------------------------------------------------
Me.FilterOn = False
Me.Filter = strPkey1 & " 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.cmb処理モード.Visible = True ' 処理区分
Me.txt名称.Visible = False ' コード名称用
Me.lbl参照タイトル.Visible = False ' 参照用タイトルラベル
Me.cmb参照用.Visible = False ' 参照用コンボ
Me.txt名称2.Visible = False ' 参照用名称表示
Me.cmbコード.SetFocus
End Sub
' *********************************************************
' キー項目処理
' *********************************************************
Private Sub cmb区分_AfterUpdate()
Me.cmbコード.Value = Empty
Me.cmbコード.Requery
cmbコード_AfterUpdate
End Sub
' *********************************************************
' キー項目処理
' *********************************************************
Private Sub cmbコード_AfterUpdate()
' -----------------------------------------------------
' 表示書き換えのちらつき防止
' -----------------------------------------------------
Me.Section(0).Visible = False
' -----------------------------------------------------
' キー変更は修正モードへ強制リセット
' -----------------------------------------------------
Me.cmb処理モード.Value = 2
' -----------------------------------------------------
' 表示エリア設定
' ★ コードの名称を表示する場合
' -----------------------------------------------------
On Error Resume Next
Me.txt名称.Value = Me.cmbコード.Column(1)
On Error GoTo 0
Me.cmb参照用.Value = ""
' -----------------------------------------------------
' 新規レコードボタン初期設定
' -----------------------------------------------------
Me.btn新規レコード.Enabled = False
If Not IsNull(Me.cmbコード.Value) Then
' -------------------------------------------------
' キーが入力されている場合
' ★ 入力されたキー値の設定をSQLで正しく記述
' -------------------------------------------------
Me.Undo
Me.FilterOn = False
Me.Filter = strPkey1 & " = " & Me.cmb区分.Value & _
" and " & strPkey2 & " = " & 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 btn更新_Click()
Dim strKey1, strKey2
If MsgBox("更新しますか?", vbOKCancel Or vbDefaultButton2 Or vbQuestion) = vbOK Then
' -------------------------------------------------
' 新規用事前処理
' ★ 新規の場合、キー項目に直接セット
' ★ 新規の時のみ設定する項目のセット
' -------------------------------------------------
If cmb処理モード = 1 Then
Me.区分.Value = Me.cmb区分.Value
Me.コード.Value = Me.cmbコード.Value
End If
' -------------------------------------------------
' 作成日と更新日がある場合にシステム日付をセット
' -------------------------------------------------
On Error Resume Next
If cmb処理モード = 1 Then
Me.作成日.Value = Date
Me.更新日.Value = Date
End If
If cmb処理モード = 2 Then
Me.更新日.Value = Date
End If
On Error GoTo 0
' -------------------------------------------------
' 更新用編集
' ★ 特殊な編集が必要な場合に記述します
' -------------------------------------------------
' -------------------------------------------------
' 更新実行
' -------------------------------------------------
bUpdate = True
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
If Err.Number <> 0 Then
MsgBox (Err.Description)
End If
On Error GoTo 0
' -----------------------------------------------------
' 現在のキーでリセット
' -----------------------------------------------------
cmbコード_AfterUpdate
End If
End Sub
| |
|
|
|