雛形2号

  対象テーブルと主キーの情報による標準化 (変更対象部分) --> キーがひとつの場合



  
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
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加




SQLの窓  天気  IT用語辞典
Yahoo!ニュース  マルチ辞書
PHP マニュアル  Google URL短縮 


フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ