雛形２号

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



  
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   管理者用   
このエントリーをはてなブックマークに追加




フリーフォントWEBサービス
フリーフォントで簡単ロゴ作成
アイコン・はんこ画像作成
フリーフォントで横書きロゴ作成
フリーフォントで縦書きロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し素材作成
フリーフォントで PDF 作成
デュアルフォント
書体見本
フリーフォント配布サイト
キーボード画像作成
フリーフォント ギャラリー
イラストACよりフリーダウンロード
UTF-8文字Tool
SQLの窓WEBサービス
リアルタイムHTML
テキスト変換
ストリートビューとMAPのコード
SyntaxHighlighter
Shadowbox 埋め込みコード作成

SQLの窓フリーソフト
SQLの窓 Build C++
販売管理B
「送る」に入れる簡易ダンプ
WMI Query
コンピュータアイコンメニュー
ドメイン内検索

素材
足成
Image * After
ぱくたそ
イラストAC
イラスト素材サイト

一般WEBツールリンク
WEB アーカイブ
疑わしいファイルや URL を分析する
HTML整形ツール
JSONLint
ttf to woff converter
Run Code
Twitter Card validator
Google URL Shortener
C#<->VB.NET

SQLの窓
logical　error
GINPRO
WAHA land
職人的フリーソフトの使い方
WEB 職人
ソース掲示板

フリーソフト
7-Zip
FileZilla
PrimoPDF(英語版)
GifCam
GIMP Portable
Classic Shell

JSライブラリ
jQuery
Lightbox
Shadowbox.js
The Google Hosted Libraries
cdnjs
Three.js