'***************************************************************************************************
' 配属一覧サンプル②(一覧表示) frmGetMdbDataTest03(Form)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/01/15(1.0.0.0)新規作成
' 17/01/22(1.0.1.0)更新登録画面追加に伴う修正
' 17/01/29(1.0.2.0)ダブルクリック抑制処置の共通クラス化対応
' 17/02/05(1.0.3.0)新規登録時は追加された行へスクロール位置を調整する対応
' 18/05/07(1.0.4.0)DataGridViewのスクロールバー表示不正の対応、初期処理をNewに移動させる対応
'***************************************************************************************************
Imports System.IO
Public Class frmGetMdbDataTest03
'===============================================================================================
Private Const g_cnsTitle As String = "配属一覧サンプル③"
Private Const g_cnsDGVColumnMAX As Integer = 5 ' DataGridView最大カラム(表示)
'-----------------------------------------------------------------------------------------------
' 背景色
Private ReadOnly g_colorRetire As Color = Color.FromArgb(220, 220, 220) ' 退職色(薄灰)
'-----------------------------------------------------------------------------------------------
' 共通クラス
Private g_objAboutMDB As clsAboutMDB3 ' データベースI/Oクラス(MDB用)
Private g_objAboutWindow As clsAboutWindow1 ' ウィンドウ制御関連クラス
Private g_objAboutDGV As clsAboutDataGridView3 ' DataGridView制御関連クラス
Private g_objOmitDoubleClick As clsOmitDoubleClick2 ' ダブルクリック抑制クラス
' 詳細登録フォーム
Private g_objSYOUSAI_Form As dlgGetMdbDataTest03 = Nothing ' 詳細登録フォーム
'-----------------------------------------------------------------------------------------------
' 一覧表示用抽出SQL文共通部
Private g_strSQL_Base As String = "" ' 抽出SQL文共通部
'-----------------------------------------------------------------------------------------------
' デフォルトのカラム幅
Private g_tblDefaultColumnWidth() As Integer ' カラム幅テーブル
'***********************************************************************************************
' ■■■ 初期化 ■■■
'***********************************************************************************************
'* 処理名 :New
'* 機能 :初期化
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2018年05月07日
'* 作成者 :井上 治
'* 更新日 :2018年05月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Public Sub New()
'-------------------------------------------------------------------------------------------
' ※Windowsフォームデザイナ初期化(必須)
Call InitializeComponent()
' フォームデザイナモード時は以下をスキップする
If Me.DesignMode Then Exit Sub
'-------------------------------------------------------------------------------------------
' データベースI/Oクラスの初期化
g_objAboutMDB = New clsAboutMDB3(Me, g_cnsMdbFileame, g_cnsMdbSubFolder)
' ウィンドウ制御関連クラスの初期化
g_objAboutWindow = New clsAboutWindow1(Me)
' ダブルクリック抑制クラスの初期化
g_objOmitDoubleClick = New clsOmitDoubleClick2(Me)
' DataGridView制御関連クラスの初期化
g_objAboutDGV = New clsAboutDataGridView3
'-------------------------------------------------------------------------------------------
' DataGridView(登録一覧)のカラム設定
Dim tblColInfo() As g_typDGVColInfo = Nothing
With g_objAboutDGV
Call .SetColumnInfo(tblColInfo, "社員CD", 50, g_cnsDG_MC) ' (00)社員コード
Call .SetColumnInfo(tblColInfo, "氏名", 100, , _
g_cnsSM_Programmatic) ' (01)氏名
Call .SetColumnInfo(tblColInfo, "部署名", 150, , _
g_cnsSM_Programmatic) ' (02)部署名
Call .SetColumnInfo(tblColInfo, "役職名", 100, , _
g_cnsSM_Programmatic) ' (03)役職名
Call .SetColumnInfo(tblColInfo, "入社日", 90, g_cnsDG_MC) ' (04)入社日
Call .SetColumnInfo(tblColInfo, "退職日", 90, g_cnsDG_MC) ' (05)退職日
Call .SetColumnInfo(tblColInfo, "部署CD", 60, g_cnsDG_MC) ' (06)部署コード(非表示)
Call .SetColumnInfo(tblColInfo, "役職CD", 50, g_cnsDG_MC) ' (07)役職コード(非表示)
Call .SetColumnInfo(tblColInfo, "カナ氏名", 150) ' (08)カナ氏名(非表示)
Call .SetColumnInfo(tblColInfo, "開始日", 90, g_cnsDG_MC) ' (09)配属開始日
' 初期カラム幅設定を退避
g_tblDefaultColumnWidth = .GetDefaultColumnWidth(tblColInfo)
' 列幅を設定退避値で置き換える
Call .AdjustColumnWidth(tblColInfo, My.Settings.ICHIRAN_COL_Width)
'---------------------------------------------------------------------------------------
' DataGridViewの初期設定(一般一覧用)
Call .InitDataGridView1(DGV_ICHIRAN, tblColInfo, 1)
'---------------------------------------------------------------------------------------
' 半角英数列のフォントをMSゴシック10Pに変更
Dim objFont10 As Font = New Font(g_cnsStdFontName, g_cnsFontSize975) ' 英数項目用
' DataGridViewのその他調整
With DGV_ICHIRAN
' プログラムSORT列指定
.Columns(1).Tag = 8 ' 氏名⇒カナ氏名
.Columns(2).Tag = 6 ' 部署名⇒部署コード
.Columns(3).Tag = 7 ' 役職名⇒役職コード
' コード、日付列は当幅フォントに変更
.Columns(0).DefaultCellStyle.Font = objFont10
.Columns(4).DefaultCellStyle.Font = objFont10
.Columns(5).DefaultCellStyle.Font = objFont10
.Columns(6).DefaultCellStyle.Font = objFont10
.Columns(7).DefaultCellStyle.Font = objFont10
.Columns(9).DefaultCellStyle.Font = objFont10
' 部署コード以降は非表示
.Columns(6).Visible = False
.Columns(7).Visible = False
.Columns(8).Visible = False
.Columns(9).Visible = False
End With
'---------------------------------------------------------------------------------------
' 列配置を設定退避値で置き換える
Call .AdjustDGVColumnDisplayIndex(DGV_ICHIRAN, My.Settings.ICHIRAN_DisplayIndex)
End With
'-------------------------------------------------------------------------------------------
' 一覧表示用抽出SQL文共通部の編集(WHERE句の前まで)
g_strSQL_Base = "SELECT H.[SCD]" ' (00)社員コード
g_strSQL_Base &= ",S.[KANJI_SEI]+S.[KANJI_MEI]" ' (01)氏名(漢字)
g_strSQL_Base &= ",B.[BUSYO_NM]" ' (02)部署名
g_strSQL_Base &= ",Y.[YAKU_NM]" ' (03)役職名
g_strSQL_Base &= ",S.[NYUSYA_YMD]" ' (04)入社日
g_strSQL_Base &= ",S.[TAISYOKU_YMD]" ' (05)退職日
g_strSQL_Base &= ",H.[BUSYO_CD]" ' (06)部署コード
g_strSQL_Base &= ",H.[YAKU_CD]" ' (07)役職コード
g_strSQL_Base &= ",S.[KANA_SEI]+S.[KANA_MEI]" ' (08)氏名(カナ)
g_strSQL_Base &= ",H.[KAISHI_YMD]" ' (09)配属開始日
g_strSQL_Base &= " FROM (((" & g_cnsMST_HAIZOKU & " AS H"
g_strSQL_Base &= g_cnsIN_JOIN & g_cnsMST_SYAIN & " AS S ON H.[SCD]=S.[SCD])"
g_strSQL_Base &= g_cnsOUT_JOIN & g_cnsMST_BUSYO & " AS B ON H.[BUSYO_CD]=B.[BUSYO_CD])"
g_strSQL_Base &= g_cnsOUT_JOIN & g_cnsMST_YAKU & " AS Y ON H.[YAKU_CD]=Y.[YAKU_CD])"
End Sub
'***********************************************************************************************
' ■■■ フォームイベント ■■■
'***********************************************************************************************
'* 処理名 :Form_FormClosed
'* 機能 :フォーム消失(FormClosed)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_FormClosed(ByVal sender As Object, _
ByVal e As FormClosedEventArgs) Handles Me.FormClosed
'-------------------------------------------------------------------------------------------
' DataGridViewの列幅、列配置等を退避
With My.Settings
.ICHIRAN_COL_Width = g_objAboutDGV.GetDGVColumnWidth(DGV_ICHIRAN)
.ICHIRAN_DisplayIndex = g_objAboutDGV.GetDGVColumnDisplayIndex(DGV_ICHIRAN)
Call g_objAboutWindow.FormSaveSettings1(.ICHIRAN_FormLocation, _
.ICHIRAN_FormSize, _
.ICHIRAN_WindowState)
' 設定を保存
.Save()
End With
'-------------------------------------------------------------------------------------------
' DataGridViewのColumnHeaderMouseClickイベントハンドラ解放(共通記述)
RemoveHandler DGV_ICHIRAN.ColumnHeaderMouseClick, _
AddressOf g_objAboutDGV.DGV_ColumnHeaderMouseClick
End Sub
'***********************************************************************************************
'* 処理名 :Form_Load
'* 機能 :フォーム初期化(Load)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2018年05月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'-------------------------------------------------------------------------------------------
' フォーム位置・サイズ制御
With My.Settings
Call g_objAboutWindow.FormAdjustLocationSize1(.ICHIRAN_FormLocation, _
.ICHIRAN_FormSize, Me.Size)
Me.WindowState = .ICHIRAN_WindowState
End With
'-------------------------------------------------------------------------------------------
' DataGridViewのColumnHeaderMouseClickイベントハンドラ追加(共通記述)
AddHandler DGV_ICHIRAN.ColumnHeaderMouseClick, _
AddressOf g_objAboutDGV.DGV_ColumnHeaderMouseClick
End Sub
'***********************************************************************************************
'* 処理名 :Form_Shown
'* 機能 :フォーム初期表示(Shown)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
'-------------------------------------------------------------------------------------------
' 一覧再更新表示
If Not FP_ListUpdate() Then
Me.Close()
Exit Sub
End If
'-------------------------------------------------------------------------------------------
' 初期表示動作完了
g_objOmitDoubleClick.Shown = True
End Sub
'***********************************************************************************************
' ■■■ コントロールイベント ■■■
'***********************************************************************************************
'* 処理名 :DGV_ICHIRAN_KeyUp
'* 機能 :グリッド表示のキーイベント(KeyUp)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub DGV_ICHIRAN_KeyUp(ByVal sender As Object, _
ByVal e As System.Windows.Forms.KeyEventArgs) _
Handles DGV_ICHIRAN.KeyUp
'-------------------------------------------------------------------------------------------
' Ctrl+Cでコピーができないようにする。
If (e.Control AndAlso (e.KeyCode = Keys.C)) Then
' クリップボードをクリア
Clipboard.Clear()
End If
End Sub
'***********************************************************************************************
'* 処理名 :DGV_ICHIRAN_CellClick
'* 機能 :グリッド表示のイベント(CellClick)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub DGV_ICHIRAN_CellClick(ByVal sender As Object, _
ByVal e As DataGridViewCellEventArgs) _
Handles DGV_ICHIRAN.CellClick
'-------------------------------------------------------------------------------------------
' ダブルクリック等の多重操作を抑制
If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub
'-------------------------------------------------------------------------------------------
' DataGridViewのセル選択
Dim intRow As Integer = e.RowIndex ' 行INDEX
' 選択行0件時はスキップ
If ((intRow < 0) OrElse (DGV_ICHIRAN.SelectedRows.Count = 0)) Then Exit Sub
' 処理中判定スイッチ対応
g_objOmitDoubleClick.OmitDoubleClick = True
'-------------------------------------------------------------------------------------------
' 詳細表示フォームを起動
Call GP_ShowEntryForm(intRow)
End Sub
'***********************************************************************************************
'* 処理名 :DGV_ICHIRAN_KeyDown
'* 機能 :グリッド表示のイベント(KeyDown)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月29日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub DGV_ICHIRAN_KeyDown(ByVal sender As Object, _
ByVal e As System.Windows.Forms.KeyEventArgs) _
Handles DGV_ICHIRAN.KeyDown
'-------------------------------------------------------------------------------------------
' ダブルクリック等の多重操作を抑制
If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub
'-------------------------------------------------------------------------------------------
' Enterキーでなければ処理なし
If ((e.KeyCode <> Keys.Enter) OrElse e.Shift) Then Exit Sub
' 表示0件時はスキップ
If DGV_ICHIRAN.SelectedCells.Count = 0 Then Exit Sub
e.Handled = True ' Enterキーで下行に移動させない
Dim intRow As Integer = DGV_ICHIRAN.SelectedCells.Item(0).RowIndex ' 行INDEX
' 行未選択でなければ処理なし
If intRow < 0 Then Exit Sub
' 処理中判定スイッチ対応
g_objOmitDoubleClick.OmitDoubleClick = True
'-------------------------------------------------------------------------------------------
' 詳細表示フォームを起動
Call GP_ShowEntryForm(intRow)
End Sub
'***********************************************************************************************
'* 処理名 :DGV_ICHIRAN_Leave
'* 機能 :グリッド表示のフォーカスアウトイベント(Leave)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub DGV_ICHIRAN_Leave(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles DGV_ICHIRAN.Leave
'-------------------------------------------------------------------------------------------
DGV_ICHIRAN.CurrentCell = Nothing
End Sub
'***********************************************************************************************
'* 処理名 :MNU_NEW_Click
'* 機能 :「新規登録」メニューイベント(Click)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub MNU_NEW_Click(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles MNU_NEW.Click
'-------------------------------------------------------------------------------------------
' ダブルクリック等の多重操作を抑制
If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub
'-------------------------------------------------------------------------------------------
' 詳細表示フォームを起動
Call GP_ShowEntryForm(-1)
End Sub
'***********************************************************************************************
' ■■■ サブ処理 ■■■
'***********************************************************************************************
'* 処理名 :FP_ListUpdate
'* 機能 :一覧再更新表示
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2018年05月07日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_ListUpdate() As Boolean
'-------------------------------------------------------------------------------------------
' 配属情報の抽出
Dim dbTbl As DataTable = Nothing ' DataTable
Dim strToday As String = FP_SQLDateSUB2(Today) ' 本日日付(編集)
Dim strSQL As String = g_strSQL_Base ' SQL文
strSQL &= " WHERE S.[NYUSYA_YMD]<=" & strToday
strSQL &= " AND (S.[TAISYOKU_YMD] IS NULL OR S.[TAISYOKU_YMD]>=" & strToday & g_cnsKO
strSQL &= " ORDER BY H.[BUSYO_CD],H.[YAKU_CD],H.[SCD];"
' DataTable取得
If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_HAIZOKU) Then Return False
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = 0 ' テーブルINDEX
With DGV_ICHIRAN
' スクロールバーを一旦、非表示にする
.ScrollBars = ScrollBars.None
' DataGridViewを一旦、非表示にする
.Visible = False
' SORTマークを部署の昇順に設定
.Columns(2).HeaderCell.SortGlyphDirection = g_cnsSO_Ascending
' 他のプログラムソート列のSortマーク解除
.Columns(1).HeaderCell.SortGlyphDirection = g_cnsSO_None
.Columns(3).HeaderCell.SortGlyphDirection = g_cnsSO_None
' 前回の一覧をクリア
If .Rows.Count <> 0 Then .Rows.Clear()
' DataTableの全件を繰り返す
Do While intIx < dbTbl.Rows.Count
' 行を追加
.Rows.Add()
' 一覧再更新表示サブ(1行単位)
Call GP_ListUpdateSub(intIx, dbTbl.Rows(intIx).ItemArray.Clone)
' 次へ
intIx += 1
Loop
' DataGridViewを再表示にする
.Visible = True
' スクロールバーを再表示する
.ScrollBars = ScrollBars.Both
End With
' データテーブルをクリア
dbTbl.Clear()
dbTbl.Reset()
Return True
End Function
'***********************************************************************************************
'* 処理名 :GP_ShowEntryForm
'* 機能 :入力(参照)用フォーム表示
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = DataGridViewの行Index(Integer)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:更新登録フォームを表示させる
'* 注意事項:
'***********************************************************************************************
Private Sub GP_ShowEntryForm(ByVal intRow As Integer)
'-------------------------------------------------------------------------------------------
Dim intUpdateMode As Integer = 1 ' 登録モード
Dim strScd As String = String.Empty ' 社員コード
' 行選択時は更新モードで動作
If intRow >= 0 Then
intUpdateMode = 2
strScd = DGV_ICHIRAN.Rows(intRow).Cells(0).Value
End If
'-------------------------------------------------------------------------------------------
' 詳細登録フォームを起動
If g_objSYOUSAI_Form Is Nothing Then
g_objSYOUSAI_Form = New dlgGetMdbDataTest03(g_objAboutMDB)
End If
With g_objSYOUSAI_Form
.prpUpdateMode = intUpdateMode
.prpScd = strScd
' 詳細画面を起動(モーダル)
.ShowDialog(Me)
' 処理中判定スイッチ対応
g_objOmitDoubleClick.OmitDoubleClick = True
' 更新が成功した場合、一覧再表示
If .prpUpdateResult <> 0 Then
Call GP_ListUpdate2(intRow, .prpScd, .prpNyusyaYmd)
End If
End With
End Sub
'***********************************************************************************************
'* 処理名 :GP_ListUpdate2
'* 機能 :一覧再更新表示(1行単位)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 更新行Index(Integer) ※新規登録時は-1
'* Arg2 = 社員コード(String)
'* Arg3 = 配属開始日(Date)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_ListUpdate2(ByVal intRow As Integer, _
ByVal strScd As String, _
ByVal dteKaishiYmd As Date)
'-------------------------------------------------------------------------------------------
' 配属の読み込み
Dim dbTbl As DataTable = Nothing ' DataTable
Dim strSQL As String = g_strSQL_Base ' SQL文
strSQL &= " WHERE H.[SCD]='" & strScd & g_cnsSC
strSQL &= " AND H.[KAISHI_YMD]=" & FP_SQLDateSUB2(dteKaishiYmd) & g_cnsCOL
' DataTable取得
If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_HAIZOKU) Then
Me.Close()
Exit Sub
End If
'-------------------------------------------------------------------------------------------
Dim blnNewRow As Boolean = False ' 新規登録判定
' 追加モード時はDataGridViewに行を追加
If intRow < 0 Then
blnNewRow = True
With DGV_ICHIRAN
intRow = .Rows.Count
.Rows.Add()
End With
End If
'-------------------------------------------------------------------------------------------
' 一覧再更新表示サブ(1行単位)
Call GP_ListUpdateSub(intRow, dbTbl.Rows(0).ItemArray.Clone)
' 新規登録時はスクロール位置を調整
If blnNewRow Then
Call g_objAboutDGV.ScrollToAddedRow(DGV_ICHIRAN, intRow)
End If
' データテーブルをクリア
dbTbl.Clear()
dbTbl.Reset()
End Sub
'***********************************************************************************************
'* 処理名 :GP_ListUpdateSub
'* 機能 :一覧再更新表示サブ(1行単位)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 行INDEX(Integer)
'* Arg2 = dbTbl.Rows(IX).ItemArray(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:FP_ListUpdateとGP_ListUpdate2から呼び出される
'***********************************************************************************************
Private Sub GP_ListUpdateSub(ByRef intRow As Integer, _
ByRef objItemArray As Object())
'-------------------------------------------------------------------------------------------
With DGV_ICHIRAN.Rows(intRow)
.Cells(0).Value = objItemArray(0) ' (00)社員コード
.Cells(1).Value = objItemArray(1) ' (01)氏名(漢字)
' 氏名(漢字)のToolTipに氏名(カナ)を設定
.Cells(1).ToolTipText = objItemArray(8)
.Cells(2).Value = objItemArray(2) ' (02)部署名
.Cells(3).Value = objItemArray(3) ' (03)役職名
.Cells(4).Value = FP_EditDate(objItemArray(4)) ' (04)入社日
.Cells(5).Value = FP_EditDate(objItemArray(5)) ' (05)退職日
.Cells(6).Value = objItemArray(6) ' (06)部署コード
.Cells(7).Value = objItemArray(7) ' (07)役職コード
.Cells(8).Value = objItemArray(8) ' (08)氏名(カナ)
.Cells(9).Value = FP_EditDate(objItemArray(9)) ' (09)配属開始日
' 退職者か(退職日有り)
If .Cells(5).Value.ToString.Length <> 0 Then
' 退職者はグレーで塗りつぶし
For intCol As Integer = 0 To g_cnsDGVColumnMAX
.Cells(intCol).Style.BackColor = g_colorRetire
Next intCol
End If
End With
End Sub
'----------------------------------------<< End of Source >>------------------------------------
End Class
'***************************************************************************************************
' 配属一覧サンプル③(更新登録画面) dlgGetMdbDataTest03(Form)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/02/05(1.0.3.0)新規作成
'***************************************************************************************************
Friend Class dlgGetMdbDataTest03
'===============================================================================================
Private Const g_cnsTitle As String = "配属一覧サンプル③"
'-----------------------------------------------------------------------------------------------
' 登録モードなどの定数
Private Const g_cnsMODE_ADD As String = "(新規登録モード)"
Private Const g_cnsMODE_UPD As String = "(変更登録モード)"
'Private Const g_cnsMODE_DSP As String = "(参照モード)"
Private Const g_cnsGUIDE_ADD As String = "「登録」ボタンで登録されます。"
Private Const g_cnsGUIDE_UPD As String = "「登録」ボタンで内容が更新されます。"
'-----------------------------------------------------------------------------------------------
Private g_objAboutMDB As clsAboutMDB3 ' データベースI/Oクラス(MDB用)
Private g_objCheckNotUpdate As clsCheckNotUpdate2 ' 未更新終了チェック関連クラス
Private g_objOmitDoubleClick As clsOmitDoubleClick2 ' ダブルクリック抑制クラス
'-----------------------------------------------------------------------------------------------
' 一覧フォームとの受け渡し項目
Private g_intUpdateMode As Integer = 0 ' 処理モード(1=新規,2=変更)
Private g_strScd As String ' 社員コード
Private g_dteNyusyaYmd As Date ' 入社日
Private g_intUpdateResult As Integer = 0 ' 更新結果(0=無,1=追加,2=更新,9=削除)
'-----------------------------------------------------------------------------------------------
' コンボボックスに対応したコードテーブル
Private g_tblBusyoCd() As String ' 部署コードテーブル
Private g_tblYakuCd() As String ' 役職コードテーブル
'***********************************************************************************************
' ■■■ 初期化 ■■■
'***********************************************************************************************
'* 処理名 :New
'* 機能 :初期化
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = データベースI/Oクラス(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub New(ByRef objAboutMDB As clsAboutMDB3)
'-------------------------------------------------------------------------------------------
' ※Windowsフォームデザイナ初期化(必須)
Call InitializeComponent()
' フォームデザイナモード時は以下をスキップする
If Me.DesignMode Then Exit Sub
'-------------------------------------------------------------------------------------------
g_objAboutMDB = objAboutMDB ' データベースI/Oクラス(MDB用)
'-------------------------------------------------------------------------------------------
' 未更新終了チェック関連クラスの初期化
g_objCheckNotUpdate = New clsCheckNotUpdate2(Me)
End Sub
'***********************************************************************************************
' ■■■ フォームイベント ■■■
'***********************************************************************************************
'* 処理名 :Form_Load
'* 機能 :フォームイベント(Load)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'-------------------------------------------------------------------------------------------
' 一旦、登録ボタン等を消去
BTN_OK.Enabled = False
'-------------------------------------------------------------------------------------------
' ダブルクリック抑制クラスの初期化
g_objOmitDoubleClick = New clsOmitDoubleClick2(Me)
End Sub
'***********************************************************************************************
'* 処理名 :Form_Shown
'* 機能 :フォーム初期表示(Shown)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub Form_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown
'-------------------------------------------------------------------------------------------
g_intUpdateResult = 0
'-------------------------------------------------------------------------------------------
' フォーム位置の保持
If Me.StartPosition <> FormStartPosition.Manual Then
Me.StartPosition = FormStartPosition.Manual
End If
'-------------------------------------------------------------------------------------------
' IME状態の初期化
TXT_KANJI_SEI.ImeMode = Windows.Forms.ImeMode.Hiragana
TXT_KANJI_MEI.ImeMode = Windows.Forms.ImeMode.Hiragana
TXT_KANA_SEI.ImeMode = Windows.Forms.ImeMode.Katakana
TXT_KANA_MEI.ImeMode = Windows.Forms.ImeMode.Katakana
'-------------------------------------------------------------------------------------------
' 初回起動時は初期セットアップを行なう
If g_objOmitDoubleClick.FirstShown Then
' コンボリスト等の初期セットアップ
If Not FP_SetFormList() Then
g_objCheckNotUpdate.FatalError = True
Me.Close()
Exit Sub
End If
g_objOmitDoubleClick.FirstShown = False
End If
'-------------------------------------------------------------------------------------------
' 新規登録モード
If g_intUpdateMode = 1 Then
' 内容表示クリア
Call GP_ClearForm()
Else
' 指定社員情報の表示
If Not FP_ShowSyainInfo() Then
g_objCheckNotUpdate.FatalError = True
Me.Close()
Exit Sub
End If
End If
' 入力コントロール表示制御
Call GP_SetFormCondition()
'-------------------------------------------------------------------------------------------
' 未登録終了警告スイッチをクリア
g_objCheckNotUpdate.NotUpdate = False
g_objOmitDoubleClick.Shown = True
End Sub
'***********************************************************************************************
' ■■■ コントロールイベント ■■■
'***********************************************************************************************
'* 処理名 :BTN_CANCEL_Click
'* 機能 :「キャンセル」ボタンイベント(Click)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub BTN_CANCEL_Click(ByVal sender As Object, _
ByVal e As System.EventArgs) Handles BTN_CANCEL.Click
'-------------------------------------------------------------------------------------------
' ダブルクリック等の多重操作を抑制
If g_objOmitDoubleClick.CheckDoubleClick(True) Then Exit Sub
'-------------------------------------------------------------------------------------------
' フォームを閉じる
Me.Close()
End Sub
'***********************************************************************************************
'* 処理名 :BTN_OK_Click
'* 機能 :「登録」ボタンイベント(Click)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub BTN_OK_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BTN_OK.Click
'-------------------------------------------------------------------------------------------
' ダブルクリック等の多重操作を抑制
If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub
'-------------------------------------------------------------------------------------------
Me.Activate()
BTN_OK.Focus()
' 「登録」ボタン処理
Call GP_OK_Click()
End Sub
'***********************************************************************************************
' ■■■ サブ処理(登録更新系) ■■■
'***********************************************************************************************
'* 処理名 :GP_OK_Click
'* 機能 :「登録」ボタン処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_OK_Click()
'-------------------------------------------------------------------------------------------
If Not g_objCheckNotUpdate.NotUpdate Then
MessageBox.Show(Me, _
"何も変更されていません。", _
g_cnsTitle, _
MessageBoxButtons.OK, _
MessageBoxIcon.Information)
Exit Sub
ElseIf Not FP_CheckForm() Then ' 登録チェック
Exit Sub
End If
'-------------------------------------------------------------------------------------------
' 新規登録時は社員コードをプロパティ項目にセット
If g_intUpdateMode = 1 Then
g_strScd = TXT_SCD.Text.ToString.Trim
End If
g_dteNyusyaYmd = DTP_NYUSYA_YMD.Value
'-------------------------------------------------------------------------------------------
' 登録確認メッセージ
If MessageBox.Show( _
Me, _
"表示されている内容を登録します。" & _
ControlChars.CrLf & ControlChars.CrLf & "よろしいですね?", _
g_cnsTitle, _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Information) <> DialogResult.Yes Then Exit Sub
' 処理中判定スイッチ対応
g_objOmitDoubleClick.OmitDoubleClick = True
'-------------------------------------------------------------------------------------------
' 登録(更新)処理
If FP_UpdateTables() Then
' 処理結果を返す
g_intUpdateResult = g_intUpdateMode
' 未登録終了警告スイッチをクリア
g_objCheckNotUpdate.NotUpdate = False
Me.Close()
End If
End Sub
'***********************************************************************************************
'* 処理名 :FP_CheckForm
'* 機能 :登録チェック
'-----------------------------------------------------------------------------------------------
'* 返り値 :チェック成否(Boolean)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_CheckForm() As Boolean
'-------------------------------------------------------------------------------------------
Dim strMSG As String = String.Empty ' エラーメッセージ
'-------------------------------------------------------------------------------------------
' 必須チェック
' 新規登録時は社員コードチェックを行なう
If g_intUpdateMode = 1 Then
' 社員コードブランク
If TXT_SCD.Text.ToString.Trim.Length = 0 Then
Call GP_AppendMessage(strMSG, "「社員№」が入力されていません。")
ElseIf Not Integer.TryParse(TXT_SCD.Text.ToString.Trim, 0I) Then
Call GP_AppendMessage(strMSG, "「社員№」が数字ではありません。")
End If
End If
' 漢字姓
If TXT_KANJI_SEI.Text.ToString.Trim.Length = 0 Then
Call GP_AppendMessage(strMSG, "「漢字氏名(姓)」が入力されていません。")
End If
' 漢字名
If TXT_KANJI_MEI.Text.ToString.Trim.Length = 0 Then
Call GP_AppendMessage(strMSG, "「漢字氏名(名)」が入力されていません。")
End If
' カナ姓
If TXT_KANA_SEI.Text.ToString.Trim.Length = 0 Then
Call GP_AppendMessage(strMSG, "「カナ氏名(姓)」が入力されていません。")
End If
' カナ名
If TXT_KANA_MEI.Text.ToString.Trim.Length = 0 Then
Call GP_AppendMessage(strMSG, "「カナ氏名(名)」が入力されていません。")
End If
' 性別未選択
If CBO_SEX.SelectedIndex < 0 Then
Call GP_AppendMessage(strMSG, "「性別」が選択されていません。")
End If
' 部署未選択
If CBO_BUSYO.SelectedIndex < 0 Then
Call GP_AppendMessage(strMSG, "「部署」が選択されていません。")
End If
' 役職未選択
If CBO_YAKU.SelectedIndex < 0 Then
Call GP_AppendMessage(strMSG, "「役職」が選択されていません。")
End If
'-------------------------------------------------------------------------------------------
' 日付チェック
Dim dteSeinenYmd As Date = DTP_SEINEN_YMD.Value ' 生年月日
Dim dteNyusyaYmd As Date = DTP_NYUSYA_YMD.Value ' 入社日
Dim dteTaisyokuYmd As Date = g_cnsMaximumDate ' 退職日
' 退職日入力有り
If DTP_TAISYOKU_YMD.Checked Then
dteTaisyokuYmd = DTP_TAISYOKU_YMD.Value
If dteTaisyokuYmd = g_cnsMaximumDate Then
Call GP_AppendMessage(strMSG, "「退職日」が正しくありません。")
End If
End If
' 入社日異常
If dteNyusyaYmd <= dteSeinenYmd Then
Call GP_AppendMessage(strMSG, "「入社日」が「生年月日」以前です。")
ElseIf dteTaisyokuYmd <= dteNyusyaYmd Then
Call GP_AppendMessage(strMSG, "「退職日」が「入社日」以前です。")
End If
'-------------------------------------------------------------------------------------------
' チェック結果
If strMSG.Length <> 0 Then
MessageBox.Show(Me, _
strMSG, _
g_cnsTitle, _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
Return False
Else
Return True
End If
End Function
'***********************************************************************************************
'* 処理名 :FP_UpdateTables
'* 機能 :登録(更新)処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_UpdateTables() As Boolean
'-------------------------------------------------------------------------------------------
Dim blnResult As Boolean = False ' 処理結果
Dim blnSuccess As Boolean = False ' 登録成否
Dim strMsgHeader As String = String.Empty ' メッセージヘッダ
Dim strMSG As String = String.Empty ' メッセージ
Dim strSQL As String = String.Empty ' SQL文
Dim strTable As String = String.Empty ' テーブル名
' MDB接続
Using dbCon As OleDb.OleDbConnection = g_objAboutMDB.GetConnection(blnResult)
' 接続失敗
If Not blnResult Then Return False
'---------------------------------------------------------------------------------------
' データベースに接続
dbCon.Open()
' トランザクション処理開始
Using dbTran As OleDb.OleDbTransaction = dbCon.BeginTransaction(), _
dbCommand As OleDb.OleDbCommand = dbCon.CreateCommand()
' コマンドにトランザクションを割り当てる
dbCommand.Transaction = dbTran
'-----------------------------------------------------------------------------------
Try
' データベーステーブル更新
blnSuccess = FP_UpdateTablesSUB(dbTran, _
dbCommand, _
strMsgHeader, _
strSQL, _
strTable, _
strMSG)
Catch ex As Exception
' 更新SQLエラー処理(致命エラー扱い)
Call g_objAboutMDB.ExecuteSQLError(ex.Message, _
strMsgHeader, _
strTable, _
strSQL)
End Try
'-----------------------------------------------------------------------------------
End Using
' データベースを切断
dbCon.Close()
'---------------------------------------------------------------------------------------
End Using
'-------------------------------------------------------------------------------------------
' エラーがあるか
If strMSG.Length <> 0 Then
' ここでのエラーには致命エラーは含まれない
MessageBox.Show(Me, _
strMSG, _
g_cnsTitle, _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End If
Return blnSuccess
End Function
'***********************************************************************************************
'* 処理名 :FP_UpdateTablesSUB
'* 機能 :データベーステーブル更新(サブ処理⇒更新本体)
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :Arg1 = OleDbTransaction(Object)
'* Arg2 = OleDbCommand(Object)
'* Arg3 = メッセージヘッダ(String) ※Ref参照
'* Arg4 = SQL文(String) ※Ref参照
'* Arg5 = 更新テーブルID(String) ※Ref参照
'* Arg6 = エラーメッセージ(String) ※Ref参照(例外は含まれない)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:例外発生時のSQL文を確保するためstrSQLはRef参照引数としている
'***********************************************************************************************
Private Function FP_UpdateTablesSUB(ByRef dbTran As OleDb.OleDbTransaction, _
ByRef dbCommand As OleDb.OleDbCommand, _
ByRef strMsgHeader As String, _
ByRef strSQL As String, _
ByRef strTable As String, _
ByRef strMSG As String) As Boolean
'===========================================================================================
FP_UpdateTablesSUB = False
strMSG = String.Empty
' 実際の内部登録モード(削除復活で置き換わることがある:このサンプルではないが)
Dim swUpdMode As Integer = g_intUpdateMode ' 実際の登録モード
strMsgHeader = g_cnsMDBMSG003 ' 参照失敗
Dim blnUpdate As Boolean = False ' 更新有りフラグ
Dim tblFldO() As Object = Nothing ' レコードフィールド
Dim tblSQL() As g_typUpdSql ' SQL文テーブル
ReDim tblSQL(-1)
'-------------------------------------------------------------------------------------------
' 現状レコードの読み出し
strTable = g_cnsMST_SYAIN
Dim strWhere As String = " WHERE [SCD]='" & g_strScd & g_cnsSC ' WHERE句
strSQL = g_cnsSELECT_AST & g_cnsMST_SYAIN & strWhere & g_cnsCOL
' DataTableにレコードを読み込む
Dim dbTbl As DataTable = FP_GetDataTable(dbCommand, strSQL) ' DataTable
' 読込レコードがあるか
If dbTbl.Rows.Count <> 0 Then
'---------------------------------------------------------------------------------------
' 当該キーのレコード有り
If g_intUpdateMode <> 1 Then
' 更新登録は更新可
blnUpdate = True
' 最終的な変更前レコード内容の取得
tblFldO = dbTbl.Rows(0).ItemArray.Clone
' NULLがあり得る日付項目はNothingに変換
Call GP_ReplaceDateFields(tblFldO, New Integer() {8})
Else
strMSG = "この「社員№」は既に登録されています。"
End If
Else
'---------------------------------------------------------------------------------------
' 当該キーのレコード無し
If g_intUpdateMode = 1 Then
' 新規登録は登録可
blnUpdate = True
Else
strMSG = "この「社員№」は登録されていません。"
End If
End If
' データテーブルをクリア
dbTbl.Clear()
dbTbl.Reset()
' 更新不可の場合は終了
If Not blnUpdate Then Return False
'===========================================================================================
' 登録更新処理
'-------------------------------------------------------------------------------------------
' 更新SQL文の編集
If swUpdMode = 1 Then
' 新規登録 ⇒ 追加登録SQL文編集(社員マスタ)
Call GP_MakeInsertSqlS(tblSQL)
' 追加登録SQL文編集(配属マスタ)
Call GP_MakeInsertSqlH(tblSQL)
Else
' 更新登録 ⇒ 更新登録SQL文編集(社員マスタ)
Call GP_MakeUpdateSqlS(tblFldO, strWhere, tblSQL)
' 配属マスタを参照
strTable = g_cnsMST_HAIZOKU
strSQL = g_cnsSELECT_AST & g_cnsMST_HAIZOKU & strWhere & g_cnsCOL
' DataTableにレコードを読み込む
dbTbl = FP_GetDataTable(dbCommand, strSQL) ' DataTable
' 読込レコードがあるか
If dbTbl.Rows.Count <> 0 Then
' 最終的な変更前レコード内容の取得
tblFldO = dbTbl.Rows(0).ItemArray.Clone
' NULLがあり得る日付項目はNothingに変換
Call GP_ReplaceDateFields(tblFldO, New Integer() {2})
' 更新登録SQL文編集(配属マスタ)
Call GP_MakeUpdateSqlH(tblFldO, strWhere, tblSQL)
Else
' 追加登録SQL文編集(配属マスタ)
Call GP_MakeInsertSqlH(tblSQL)
End If
End If
'-------------------------------------------------------------------------------------------
' 更新対象があるか
If tblSQL.Length <> 0 Then
strMsgHeader = g_cnsMDBMSG002
' 登録・更新SQL文を発行
For Each objSQL As g_typUpdSql In tblSQL
strTable = objSQL.TableId
strSQL = objSQL.SQL
' コマンド発行
dbCommand.CommandText = strSQL
dbCommand.ExecuteNonQuery()
Next objSQL
'---------------------------------------------------------
' コミット
dbTran.Commit()
Return True
Else
' 更新項目無し
strMSG = "更新対象項目がありませんでした。"
End If
End Function
'***********************************************************************************************
'* 処理名 :GP_MakeInsertSqlS
'* 機能 :追加登録SQL文編集(社員マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 更新SQL文テーブル(Array:Structure) ※Ref参照
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_MakeInsertSqlS(ByRef tblSQL() As g_typUpdSql)
'-------------------------------------------------------------------------------------------
' フォーム上のアイテムから更新用テーブルを作成(社員マスタ)
Dim tblFldN() As Object = FP_SetTableFromItemsS() ' 新規登録側テーブル
'-------------------------------------------------------------------------------------------
' INSERT文の編集
Dim strSQL As String = FP_SqlInsertCommon(g_cnsMST_SYAIN, g_tblFld_MST_SYAIN)
' 先頭フィールドをセット
strSQL &= g_cnsSC & tblFldN(0) & g_cnsSC
Dim intIx As Integer = 1 ' フィールドINDEX
' 以降を繰り返す
Do While intIx <= g_tblFld_MST_SYAIN.GetUpperBound(0)
' データタイプによる判断(このサンプルは文字列と日付のみ)
Select Case g_tblFldTyp_MST_SYAIN(intIx)
Case 5 ' 日付
strSQL &= g_cnsCOM & FP_SQLDateSUB2(tblFldN(intIx))
Case Else ' 文字列
strSQL &= g_cnsCOM & FP_SQLStringSUB(tblFldN(intIx))
End Select
' 次のフィールドへ
intIx += 1
Loop
strSQL &= g_cnsKOCOL
' 更新SQL文テーブルに追加
Call GP_AppendSqlTable(strSQL, g_cnsMST_SYAIN, tblSQL)
End Sub
'***********************************************************************************************
'* 処理名 :GP_MakeInsertSqlH
'* 機能 :追加登録SQL文編集(配属マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 更新SQL文テーブル(Array:Structure) ※Ref参照
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_MakeInsertSqlH(ByRef tblSQL() As g_typUpdSql)
'-------------------------------------------------------------------------------------------
' フォーム上のアイテムから更新用テーブルを作成(配属マスタ)
Dim tblFldN() As Object = FP_SetTableFromItemsH() ' 新規登録側テーブル
'-------------------------------------------------------------------------------------------
' INSERT文の編集
Dim strSQL As String = FP_SqlInsertCommon(g_cnsMST_HAIZOKU, g_tblFld_MST_HAIZOKU)
' 先頭フィールドをセット
strSQL &= g_cnsSC & tblFldN(0) & g_cnsSC
Dim intIx As Integer = 1 ' フィールドINDEX
' 以降を繰り返す
Do While intIx <= g_tblFld_MST_HAIZOKU.GetUpperBound(0)
' データタイプによる判断(このサンプルは文字列と日付のみ)
Select Case g_tblFldTyp_MST_HAIZOKU(intIx)
Case 5 ' 日付
strSQL &= g_cnsCOM & FP_SQLDateSUB2(tblFldN(intIx))
Case Else ' 文字列
strSQL &= g_cnsCOM & FP_SQLStringSUB(tblFldN(intIx))
End Select
' 次のフィールドへ
intIx += 1
Loop
strSQL &= g_cnsKOCOL
' 更新SQL文テーブルに追加
Call GP_AppendSqlTable(strSQL, g_cnsMST_HAIZOKU, tblSQL)
End Sub
'***********************************************************************************************
'* 処理名 :GP_MakeUpdateSqlS
'* 機能 :更新登録SQL文編集(社員マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 現行テーブル内容(Array:Object)
'* Arg2 = WHERE句(String)
'* Arg3 = 更新SQL文テーブル(Array:Structure) ※Ref参照
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_MakeUpdateSqlS(ByVal tblFldO() As Object, _
ByVal strWhere As String, _
ByRef tblSQL() As g_typUpdSql)
'-------------------------------------------------------------------------------------------
' フォーム上のアイテムから更新用テーブルを作成(社員マスタ)
Dim tblFldN() As Object = FP_SetTableFromItemsS() ' 新規登録側テーブル
'-------------------------------------------------------------------------------------------
' UPDATE文を編集
Dim strSQL As String = g_cnsUPDATE & g_cnsMST_SYAIN & g_cnsSET ' SQL文
Dim intIx As Integer = 1 ' フィールドINDEX
Dim intCntUpd As Integer = 0 ' 更新項目件数
' キー項目以後を繰り返す
Do While intIx <= g_tblFld_MST_SYAIN.GetUpperBound(0)
' 変更がある項目のみSQLに追加
If tblFldN(intIx) <> tblFldO(intIx) Then
' 更新項目件数を加算
intCntUpd += 1
' 2フィールド目以降はカンマを付加
If intCntUpd > 1 Then
strSQL &= g_cnsCOM
End If
' 値が変更されたフィールドのみ更新
strSQL &= g_tblFld_MST_SYAIN(intIx) & g_cnsEQ
' データタイプ判定
Select Case g_tblFldTyp_MST_SYAIN(intIx)
Case 5 ' 日付
strSQL &= FP_SQLDateSUB2(tblFldN(intIx))
Case Else ' 文字列
strSQL &= FP_SQLStringSUB(tblFldN(intIx))
End Select
End If
' 次のフィールドへ
intIx += 1
Loop
' 更新項目があったか
If intCntUpd <> 0 Then
' WHERE句を接続
strSQL &= strWhere
' 更新SQL文テーブルに追加
Call GP_AppendSqlTable(strSQL, g_cnsMST_SYAIN, tblSQL)
End If
End Sub
'***********************************************************************************************
'* 処理名 :GP_MakeUpdateSqlH
'* 機能 :更新登録SQL文編集(配属マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 現行テーブル内容(Array:Object)
'* Arg2 = WHERE句(String)
'* Arg3 = 更新SQL文テーブル(Array:Structure) ※Ref参照
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_MakeUpdateSqlH(ByVal tblFldO() As Object, _
ByVal strWhere As String, _
ByRef tblSQL() As g_typUpdSql)
'-------------------------------------------------------------------------------------------
' フォーム上のアイテムから更新用テーブルを作成(配属マスタ)
Dim tblFldN() As Object = FP_SetTableFromItemsH() ' 新規登録側テーブル
'-------------------------------------------------------------------------------------------
' UPDATE文を編集
Dim strSQL As String = g_cnsUPDATE & g_cnsMST_HAIZOKU & g_cnsSET ' SQL文
Dim intIx As Integer = 1 ' フィールドINDEX
Dim intCntUpd As Integer = 0 ' 更新項目件数
' キー項目以後を繰り返す(開始日の更新を含みます)
Do While intIx <= g_tblFld_MST_HAIZOKU.GetUpperBound(0)
' 変更がある項目のみSQLに追加
If tblFldN(intIx) <> tblFldO(intIx) Then
' 更新項目件数を加算
intCntUpd += 1
' 2フィールド目以降はカンマを付加
If intCntUpd > 1 Then
strSQL &= g_cnsCOM
End If
' 値が変更されたフィールドのみ更新
strSQL &= g_tblFld_MST_HAIZOKU(intIx) & g_cnsEQ
' データタイプ判定
Select Case g_tblFldTyp_MST_HAIZOKU(intIx)
Case 5 ' 日付
strSQL &= FP_SQLDateSUB2(tblFldN(intIx))
Case Else ' 文字列
strSQL &= FP_SQLStringSUB(tblFldN(intIx))
End Select
End If
' 次のフィールドへ
intIx += 1
Loop
' 更新項目があったか
If intCntUpd <> 0 Then
' WHERE句を接続
strSQL &= strWhere
' 更新SQL文テーブルに追加
Call GP_AppendSqlTable(strSQL, g_cnsMST_HAIZOKU, tblSQL)
End If
End Sub
'***********************************************************************************************
'* 処理名 :FP_SetTableFromItemsS
'* 機能 :フォーム上のアイテムから更新用テーブルを作成(社員マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :テーブル(Array:Object)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2013年12月05日
'* 作成者 :井上 治
'* 更新日 :2013年12月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_SetTableFromItemsS() As Object()
'-------------------------------------------------------------------------------------------
Dim tblFldN() As Object ' 新規登録側テーブル
ReDim tblFldN(g_tblFld_MST_SYAIN.GetUpperBound(0))
' 各フィールドをセット
tblFldN(0) = g_strScd ' (00)社員コード
tblFldN(1) = TXT_KANJI_SEI.Text.ToString.Trim ' (01)漢字姓
tblFldN(2) = TXT_KANJI_MEI.Text.ToString.Trim ' (02)漢字名
tblFldN(3) = TXT_KANA_SEI.Text.ToString.Trim ' (03)カナ姓
tblFldN(4) = TXT_KANA_MEI.Text.ToString.Trim ' (04)カナ名
tblFldN(5) = CBO_SEX.Text ' (05)性別
tblFldN(6) = DTP_SEINEN_YMD.Value ' (06)生年月日
tblFldN(7) = DTP_NYUSYA_YMD.Value ' (07)入社日
' 退職日
If DTP_TAISYOKU_YMD.Checked Then
tblFldN(8) = DTP_TAISYOKU_YMD.Value ' (08)退職日
Else
tblFldN(8) = g_cnsNullDate
End If
Return tblFldN
End Function
'***********************************************************************************************
'* 処理名 :FP_SetTableFromItemsH
'* 機能 :フォーム上のアイテムから更新用テーブルを作成(配属マスタ)
'-----------------------------------------------------------------------------------------------
'* 返り値 :テーブル(Array:Object)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2013年12月05日
'* 作成者 :井上 治
'* 更新日 :2013年12月05日
'* 更新者 :井上 治
'* 機能説明:このサンプルは入社日時点の配属を作成・更新するのみ
'* 注意事項:
'***********************************************************************************************
Private Function FP_SetTableFromItemsH() As Object()
Dim tblFldN() As Object ' 新規登録側テーブル
ReDim tblFldN(g_tblFld_MST_HAIZOKU.GetUpperBound(0))
' 各フィールドをセット
tblFldN(0) = g_strScd ' (00)社員コード
tblFldN(1) = DTP_NYUSYA_YMD.Value ' (01)開始日(入社日)
' 終了日
If DTP_TAISYOKU_YMD.Checked Then
tblFldN(2) = DTP_TAISYOKU_YMD.Value ' (02)終了日(退職日)
Else
tblFldN(2) = g_cnsNullDate
End If
tblFldN(3) = g_tblBusyoCd(CBO_BUSYO.SelectedIndex) ' (03)部署コード
tblFldN(4) = g_tblYakuCd(CBO_YAKU.SelectedIndex) ' (04)役職コード
Return tblFldN
End Function
'***********************************************************************************************
' ■■■ サブ処理(表示系) ■■■
'***********************************************************************************************
'* 処理名 :FP_ShowSyainInfo
'* 機能 :指定社員情報の表示
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_ShowSyainInfo() As Boolean
'-------------------------------------------------------------------------------------------
' 明細内容表示クリア
Call GP_ClearForm()
' 社員マスタ、配属マスタの現在状態を参照(入社日時点のみ)
Dim dbTbl As DataTable = Nothing ' DataTable
Dim strSQL As String = "SELECT S.[KANJI_SEI]" ' (00)漢字姓
strSQL &= ",S.[KANJI_MEI]" ' (01)漢字名
strSQL &= ",S.[KANA_SEI]" ' (02)カナ姓
strSQL &= ",S.[KANA_MEI]" ' (03)カナ名
strSQL &= ",S.[SEX]" ' (04)性別
strSQL &= ",S.[SEINEN_YMD]" ' (05)生年月日
strSQL &= ",S.[NYUSYA_YMD]" ' (06)入社日
strSQL &= ",S.[TAISYOKU_YMD]" ' (07)退職日
strSQL &= ",H.[BUSYO_CD]" ' (08)部署コード
strSQL &= ",H.[YAKU_CD]" ' (09)役職コード
strSQL &= " FROM (" & g_cnsMST_SYAIN & " AS S"
strSQL &= g_cnsOUT_JOIN & g_cnsMST_HAIZOKU & " AS H"
strSQL &= " ON (H.[SCD]=S.[SCD] AND H.[KAISHI_YMD]=S.[NYUSYA_YMD]))"
strSQL &= " WHERE S.[SCD]='" & g_strScd & g_cnsSCCOL
' DataTable取得
If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_SYAIN) Then Return False
' 各コントロールに値をセット
TXT_SCD.Text = g_strScd ' 社員コード
TXT_KANJI_SEI.Text = dbTbl.Rows(0)(0) ' 漢字姓
TXT_KANJI_MEI.Text = dbTbl.Rows(0)(1) ' 漢字名
TXT_KANA_SEI.Text = dbTbl.Rows(0)(2) ' カナ姓
TXT_KANA_MEI.Text = dbTbl.Rows(0)(3) ' カナ名
CBO_SEX.Text = dbTbl.Rows(0)(4) ' 性別
DTP_SEINEN_YMD.Value = dbTbl.Rows(0)(5) ' 生年月日
DTP_NYUSYA_YMD.Value = dbTbl.Rows(0)(6) ' 入社日
' 退職判定?
If Not DBNull.Value.Equals(dbTbl.Rows(0)(7)) Then
DTP_TAISYOKU_YMD.Checked = True
DTP_TAISYOKU_YMD.Value = dbTbl.Rows(0)(7)
End If
' コンボボックスの選択をコードテーブルで行なう
Call GP_SetComboIndexByCode(CBO_BUSYO, dbTbl.Rows(0)(8), g_tblBusyoCd) ' 部署
Call GP_SetComboIndexByCode(CBO_YAKU, dbTbl.Rows(0)(9), g_tblYakuCd) ' 役職
Return True
End Function
'***********************************************************************************************
'* 処理名 :GP_SetFormCondition
'* 機能 :フォームの状態制御
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:本サンプルでは参照モードの動作はありません
'***********************************************************************************************
Private Sub GP_SetFormCondition()
'-------------------------------------------------------------------------------------------
' 更新モードによる分岐
Select Case g_intUpdateMode
Case 1 ' 新規登録モード
' 社員コードは入力可
With TXT_SCD
.ReadOnly = False
.TabStop = True
.ForeColor = Color.Black
.BackColor = Color.Empty
.Select()
End With
STS_MODE.Text = g_cnsMODE_ADD
STS_GUIDE.Text = g_cnsGUIDE_ADD
BTN_OK.Enabled = True
'-----------------------------------------------------------------------------------
Case Else ' 更新登録モード
' 社員コードは入力不可
With TXT_SCD
.ReadOnly = True
.TabStop = False
.ForeColor = Color.Blue
.BackColor = Color.LightYellow
End With
TXT_KANJI_SEI.Select()
STS_MODE.Text = g_cnsMODE_UPD
STS_GUIDE.Text = g_cnsGUIDE_UPD
BTN_OK.Enabled = True
End Select
End Sub
'***********************************************************************************************
'* 処理名 :GP_ClearForm
'* 機能 :明細内容表示クリア
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Sub GP_ClearForm()
'-------------------------------------------------------------------------------------------
TXT_SCD.Text = String.Empty
TXT_KANJI_SEI.Text = String.Empty
TXT_KANJI_MEI.Text = String.Empty
TXT_KANA_SEI.Text = String.Empty
TXT_KANA_MEI.Text = String.Empty
CBO_SEX.SelectedIndex = 0
DTP_SEINEN_YMD.Value = Today
DTP_NYUSYA_YMD.Value = Today
' 退職日は一旦チェックを付けて最大日付をセットしてからチェックを外す
With DTP_TAISYOKU_YMD
.Checked = True
.Value = g_cnsMaximumDate
.Checked = False
End With
CBO_BUSYO.SelectedIndex = -1
CBO_YAKU.SelectedIndex = -1
End Sub
'***********************************************************************************************
'* 処理名 :FP_SetFormList
'* 機能 :コンボリスト等の初期セットアップ
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :(なし)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Private Function FP_SetFormList() As Boolean
'-------------------------------------------------------------------------------------------
' 部署コンボリストの生成
Dim dbTbl As DataTable = Nothing ' DataTable
Dim strSQL As String = "SELECT [BUSYO_CD]" ' (00)部署コード
strSQL &= ",[BUSYO_NM]" ' (01)部署名
strSQL &= g_cnsFROM & g_cnsMST_BUSYO
strSQL &= " ORDER BY [BUSYO_CD];"
' DataTable取得
If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_BUSYO) Then Return False
' コンボボックスのリストセット
Call GP_SetComboBoxList(CBO_BUSYO, dbTbl, g_tblBusyoCd)
'-------------------------------------------------------------------------------------------
' 役職コンボリストの生成
strSQL = "SELECT [YAKU_CD]" ' (00)役職コード
strSQL &= ",[YAKU_NM]" ' (01)役職名
strSQL &= g_cnsFROM & g_cnsMST_YAKU
strSQL &= " ORDER BY [YAKU_CD];"
' DataTable取得
If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_YAKU) Then Return False
' コンボボックスのリストセット
Call GP_SetComboBoxList(CBO_YAKU, dbTbl, g_tblYakuCd)
dbTbl.Clear()
dbTbl.Reset()
Return True
End Function
'***********************************************************************************************
' プロパティ
'***********************************************************************************************
' 処理モード(1=新規,2=変更)(Integer)
'-----------------------------------------------------------------------------------------------
Friend WriteOnly Property prpUpdateMode As Integer
Set(value As Integer)
g_intUpdateMode = value
End Set
End Property
'===============================================================================================
' 社員コード(String)
'-----------------------------------------------------------------------------------------------
Friend Property prpScd As String
Get
Return g_strScd
End Get
Set(value As String)
g_strScd = value
End Set
End Property
'===============================================================================================
' 入社日(Date)
'-----------------------------------------------------------------------------------------------
Friend ReadOnly Property prpNyusyaYmd As Date
Get
Return g_dteNyusyaYmd
End Get
End Property
'===============================================================================================
' 更新結果(0=無,1=追加,2=更新,9=削除)(Integer)
'-----------------------------------------------------------------------------------------------
Friend ReadOnly Property prpUpdateResult As Integer
Get
Return g_intUpdateResult
End Get
End Property
'----------------------------------------<< End of Source >>------------------------------------
End Class
種別 | 名称 | 内容 |
---|---|---|
クラス | データベースI/Oクラス (clsAboutMDB3) |
前ページでclsAboutMDB2として説明しましたが、 新たに新規登録の機能が加わったため、これに関するプロシージャを追加しています。 |
DataGridView制御クラス (clsAboutDataGridView3) |
前々ページでclsAboutDataGridView1として説明しましたが、 新たに新規登録の機能が加わったため、これに関するプロシージャとして、新規登録後に一覧に行が加わった時にその行にジャンプするためのプロシージャを追加しています。 |
'***************************************************************************************************
' サンプル用データベースI/O関連定数(MDB用) modAboutMDB3(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' ※この下に「データベースI/Oクラス(MDB用)(clsAboutMDB)」があります
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/01/15(1.0.0.0)新規作成
' 17/01/22(1.0.1.0)FP_GetDataTable、GP_AppendSqlTable等を追加(更新登録機能対応)
' 17/02/05(1.0.1.0)FP_SqlInsertCommonの追加(更新登録機能対応)
'***************************************************************************************************
Imports System.IO
Module modAboutMDB3
'===============================================================================================
' WorkTable名
Friend Const g_cnsMdbTempTable1 As String = "MdbTempTable1"
Friend Const g_cnsMdbTempTable2 As String = "MdbTempTable2"
Friend Const g_cnsMdbTempTable3 As String = "MdbTempTable3"
' エラーメッセージ
Friend Const g_cnsMDBMSG001 As String = "データベースに接続できませんでした。"
Friend Const g_cnsMDBMSG002 As String = "データベースの更新に失敗しました。"
Friend Const g_cnsMDBMSG003 As String = "データベースの参照に失敗しました。"
Friend Const g_cnsMDBMSG011 As String = "このコードのデータは既に登録されています。"
Friend Const g_cnsMDBMSG012 As String = "このコードのデータは登録されていません。"
Friend Const g_cnsMDBMSG013 As String = "このコードのデータは既に削除済みです。"
Friend Const g_cnsMDBMSG021 As String = "出力対象データが存在しません。"
' MDB共通利用固定文字
Friend Const g_cnsKA As String = "("
Friend Const g_cnsKO As String = ")"
Friend Const g_cnsKA2 As String = "["
Friend Const g_cnsKO2 As String = "]"
Friend Const g_cnsFROM As String = " FROM "
Friend Const g_cnsWHERE As String = " WHERE "
Friend Const g_cnsSET As String = " SET "
Friend Const g_cnsIN_JOIN As String = " INNER JOIN "
Friend Const g_cnsOUT_JOIN As String = " LEFT OUTER JOIN "
Friend Const g_cnsAND As String = " AND "
Friend Const g_cnsOR As String = " OR "
Friend Const g_cnsSELECT As String = "SELECT "
Friend Const g_cnsSELECT_AST As String = "SELECT * FROM "
Friend Const g_cnsINSERT As String = "INSERT INTO "
Friend Const g_cnsUPDATE As String = "UPDATE "
Friend Const g_cnsDELETE As String = "DELETE FROM "
Friend Const g_cnsCOM As String = ","
Friend Const g_cnsSC As String = "'"
Friend Const g_cnsCOMSC As String = ",'"
Friend Const g_cnsSCCOM As String = "',"
Friend Const g_cnsSCCOMSC As String = "','"
Friend Const g_cnsNULL As String = "NULL"
Friend Const g_cnsCOMNULL As String = g_cnsCOM & g_cnsNULL
Friend Const g_cnsSCCOL As String = "';"
Friend Const g_cnsCOL As String = ";"
Friend Const g_cnsKOCOL As String = ");"
Friend Const g_cnsEQ As String = "="
Friend Const g_cnsEQSC As String = "='"
Friend Const g_cnsPERSC As String = "%'"
Friend Const g_cnsSCPER As String = "'%"
Friend Const g_cnsSH As String = "#"
'-----------------------------------------------------------------------------------------------
' 更新SQL文収容テーブルユーザー定義
Friend Structure g_typUpdSql
Dim TableId As String ' 更新テーブルID
Dim SQL As String ' 更新SQL文
End Structure
'***********************************************************************************************
' ■■■ MDB更新関連サブ処理 ■■■
'***********************************************************************************************
'* 処理名 :FP_GetDataTable
'* 機能 :OleDbCommandからDataTableを取得
'-----------------------------------------------------------------------------------------------
'* 返り値 :DataTable(Object)
'* 引数 :Arg1 = SqlCommand(Object)
'* Arg2 = SQLのSELECT文(String)
'* Arg3 = データテーブル名(String) ※Option(※)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:本処理内で例外は判定していない
'***********************************************************************************************
Friend Function FP_GetDataTable(ByRef dbCommand As OleDb.OleDbCommand, _
ByVal strSQL As String, _
Optional ByVal strWorkTable As String = g_cnsMdbTempTable1) _
As DataTable
'-------------------------------------------------------------------------------------------
dbCommand.CommandText = strSQL
Using dbDAdp As New OleDb.OleDbDataAdapter, dbDSet As New DataSet
' DataSetを取得
dbDAdp.SelectCommand = dbCommand
dbDAdp.Fill(dbDSet, strWorkTable)
' DataTableを返す
FP_GetDataTable = dbDSet.Tables(strWorkTable)
End Using
End Function
'***********************************************************************************************
'* 処理名 :GP_AppendSqlTable
'* 機能 :更新用SQL文テーブルにSQL文を追加
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 追加するSQL文(String)
'* Arg2 = 追加するテーブルID(String)
'* Arg3 = SQL文テーブル(Array:g_typUpdSql)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub GP_AppendSqlTable(ByVal strSQL As String, _
ByVal strTableId As String, _
ByRef tblSQL() As g_typUpdSql)
'-------------------------------------------------------------------------------------------
Dim intMax As Integer = tblSQL.Length ' テーブル最大要素(追加)
ReDim Preserve tblSQL(intMax)
With tblSQL(intMax)
.TableId = strTableId
.SQL = strSQL
End With
End Sub
'***********************************************************************************************
'* 処理名 :FP_SQLStringSUB
'* 機能 :SQL文文字列項目補助処理
'-----------------------------------------------------------------------------------------------
'* 返り値 :SQL文用項目文字列(String)
'* 引数 :Arg1 = 入力項目文字列(String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:Trim処理及びシングルクォーテーション二重化
'* 注意事項:前後にシングルクォーテーションが付加されます。
'***********************************************************************************************
Friend Function FP_SQLStringSUB(ByVal strInText As String) As String
'-------------------------------------------------------------------------------------------
Dim strInText2 As String = String.Empty & strInText
FP_SQLStringSUB = g_cnsSC & strInText2.Trim.Replace("'", "''") & g_cnsSC
End Function
'***********************************************************************************************
'* 処理名 :FP_SQLDateSUB2
'* 機能 :SQL文日付項目補助処理(MDB用)
'-----------------------------------------------------------------------------------------------
'* 返り値 :SQL文用項目文字列(String)
'* 引数 :Arg1 = 入力項目日付(Date)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:Trim処理及び日付書式フォーマット
'* 注意事項:前後にシングルクォーテーションが付加されます。
'***********************************************************************************************
Friend Function FP_SQLDateSUB2(ByVal dteInDate As Date) As String
'-------------------------------------------------------------------------------------------
If dteInDate <> g_cnsNullDate Then
Return g_cnsSH & dteInDate.ToString(g_cnsFormatDate) & g_cnsSH
Else
Return g_cnsNULL
End If
End Function
'***********************************************************************************************
'* 処理名 :FP_SqlInsertCommon
'* 機能 :SQL(INSERT)文共通部編集
'-----------------------------------------------------------------------------------------------
'* 返り値 :SQL文一部文字列(String)
'* 引数 :Arg1 = テーブルID(string)
'* Arg2 = フィールド名配列(Array:String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:"INSERT INTO"から"VALUES ("までを編集
'* 注意事項:
'***********************************************************************************************
Friend Function FP_SqlInsertCommon(ByVal strTableId As String, _
ByRef tblFieldId() As String) As String
'-------------------------------------------------------------------------------------------
' INSERT文の先頭から編集
Dim strSQL As String = g_cnsINSERT & strTableId
strSQL &= " (" & tblFieldId(0)
Dim intIx As Integer = 1 ' テーブルINDEX
' フィールドIDを
Do While intIx <= tblFieldId.GetUpperBound(0)
strSQL &= g_cnsCOM & tblFieldId(intIx)
intIx += 1
Loop
strSQL &= ") VALUES ("
Return strSQL
End Function
'---------------------------------------<< End of Source >>-------------------------------------
End Module
'***************************************************************************************************
' サンプル用データベースI/Oクラス(MDB用) clsAboutMDB3(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/01/15(1.0.0.0)新規作成
' 17/01/22(1.0.1.0)GetConnection、ExecuteSQLErrorの追加(更新登録機能対応)
' 17/03/11(1.0.1.0)ACCDBでの変更箇所をコメントで追加する対応
'***************************************************************************************************
Friend Class clsAboutMDB3
'===============================================================================================
Private Const g_cnsMDB_Connect1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"
'Private Const g_cnsMDB_Connect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" ' ←ACCDBの場合
'-----------------------------------------------------------------------------------------------
Private g_strConnectionString As String = "" ' 接続文字列
Private g_objOwnerForm As Form = Nothing ' 親フォーム
'***********************************************************************************************
' ■■■ 初期化 ■■■
'***********************************************************************************************
'* 処理名 :New
'* 機能 :初期化
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = 親フォーム(Object)
'* Arg2 = MDBファイル名(String)
'* Arg3 = MDBサブフォルダ名(String)
'* Arg4 = MDBの接続ユーザーID(String) ※Option
'* Arg5 = MDBの接続パスワード(String) ※Option
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub New(ByVal objOwnerForm As Form, _
ByVal strMdbFilename As String, _
ByVal strMdbSubFolder As String, _
Optional ByVal strMdbUserId As String = "", _
Optional ByVal strMdbPassword As String = "")
'-------------------------------------------------------------------------------------------
g_objOwnerForm = objOwnerForm
' MDB接続文字列の編集
g_strConnectionString = FP_GetMdbConnectionString(strMdbFilename, _
strMdbSubFolder, _
strMdbUserId, _
strMdbPassword)
End Sub
'***********************************************************************************************
' ■■■ OleDbアクセス関連共通サブ処理 ■■■
'***********************************************************************************************
'* 処理名 :GetDataTableOle
'* 機能 :データテーブルを取得(OLE非接続処理)
'-----------------------------------------------------------------------------------------------
'* 返り値 :処理成否(Boolean)
'* 引数 :Arg1 = DataTable(Object) ※Ref参照(戻り値)
'* Arg2 = SQL文(String)
'* Arg3 = 参照テーブルID(String) ※カッコ付きテーブル名
'* Arg4 = エラーメッセージ(String) ※Option(エラー表示させない時の通知用)
'* Arg5 = データテーブル名(String) ※Option
'* Arg6 = エラー表示スイッチ(Boolean) ※Option(内部でエラー表示させる)
'* Arg7 = 無データエラースイッチ(Boolean) ※Option(0件をエラー扱いにしない)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:データテーブル名は"MdbTempTable1"がデフォルト
'* 注意事項:
'***********************************************************************************************
Friend Function GetDataTableOle(ByRef dbTbl As DataTable, _
ByVal strSQL As String, _
ByVal strTableName As String, _
Optional ByRef strFatalErrMSG As String = "", _
Optional ByVal strWorkTable As String = g_cnsMdbTempTable1, _
Optional ByVal swDispError As Boolean = True, _
Optional ByVal swNoDataError As Boolean = False) As Boolean
'-------------------------------------------------------------------------------------------
Dim strMSG As String = g_cnsMDBMSG001 ' エラーメッセージ
dbTbl = Nothing
Using dbCon As New OleDb.OleDbConnection, dbDSet As New DataSet
Try
'-----------------------------------------------------------------------------------
' MDBコネクションを取得
dbCon.ConnectionString = g_strConnectionString
'-----------------------------------------------------------------------------------
' 参照SQLの発行(DataAdapter)
strMSG = g_cnsMDBMSG003
Using dbDAdp As New OleDb.OleDbDataAdapter(strSQL, dbCon)
' DataSetを取得
dbDAdp.Fill(dbDSet, strWorkTable)
' DataTableを返す
dbTbl = dbDSet.Tables(strWorkTable)
' 0件確認
If (swNoDataError AndAlso (dbTbl.Rows.Count = 0)) Then
' 0件をエラーとする場合の処置
strFatalErrMSG = g_cnsMDBMSG021 & FP_ChangeRoundBrackets(strTableName)
' メッセージ表示
If swDispError Then
MessageBox.Show(g_objOwnerForm, _
strFatalErrMSG, _
g_objOwnerForm.Text, _
MessageBoxButtons.OK, _
MessageBoxIcon.Error)
End If
Return False
End If
End Using
Return True
Catch ex As Exception
'-----------------------------------------------------------------------------------
' 接続・参照不成功(一般例外)
strFatalErrMSG = strMSG & FP_ChangeRoundBrackets(strTableName) & _
ControlChars.CrLf & ex.Message
' メッセージ表示
If swDispError Then
MessageBox.Show(g_objOwnerForm, _
strFatalErrMSG, _
g_objOwnerForm.Text, _
MessageBoxButtons.OK, _
MessageBoxIcon.Error)
End If
Return False
End Try
End Using
End Function
'***********************************************************************************************
'* 処理名 :GetConnection
'* 機能 :OleDbConnectionの取得
'-----------------------------------------------------------------------------------------------
'* 返り値 :OleDbConnection(Object)
'* 引数 :Arg1 = 処理成否(Boolean) ※Ref参照
'* Arg2 = エラーメッセージ(String) ※Option(エラー表示させない時の通知用)
'* Arg3 = エラー表示スイッチ(Boolean) ※Option
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Function GetConnection(ByRef blnResult As Boolean, _
Optional ByRef strFatalErrMSG As String = "", _
Optional ByVal swDispError As Boolean = True) _
As OleDb.OleDbConnection
'-------------------------------------------------------------------------------------------
Try
blnResult = True
Return New OleDb.OleDbConnection(g_strConnectionString)
Catch ex As Exception
strFatalErrMSG = ex.Message
' メッセージ表示
If swDispError Then
MessageBox.Show(g_objOwnerForm, _
strFatalErrMSG, _
g_objOwnerForm.Text, _
MessageBoxButtons.OK, _
MessageBoxIcon.Error)
End If
blnResult = False
Return Nothing
End Try
End Function
'***********************************************************************************************
'* 処理名 :ExecuteSQLError
'* 機能 :更新SQLエラー処理(致命エラー扱い)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = エラーメッセージ(String)
'* Arg2 = 処理工程(String)
'* Arg3 = 更新テーブルID(String)
'* Arg5 = SQL文(String) ※Option
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月22日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub ExecuteSQLError(ByVal strErrMessage As String, _
ByVal strWork As String, _
ByVal strTableId As String, _
Optional ByVal strSQL As String = "")
'-------------------------------------------------------------------------------------------
Dim strMSG As String = String.Empty ' エラーメッセージ
' エラーメッセージの編集
If strWork.Length <> 0 Then
strMSG = strWork & FP_ChangeRoundBrackets(strTableId) & ControlChars.CrLf & _
strErrMessage
Else
strMSG = strErrMessage
If strTableId.Length <> 0 Then
strMSG &= FP_ChangeRoundBrackets(strTableId)
End If
End If
' SQL文があれば接続
If strSQL.Length <> 0 Then
strMSG &= ControlChars.CrLf & strSQL
End If
' エラーメッセージの表示
MessageBox.Show(g_objOwnerForm, _
strMSG, _
g_objOwnerForm.Text, _
MessageBoxButtons.OK, _
MessageBoxIcon.Error)
End Sub
'***********************************************************************************************
' ■■■ 共通サブ処理(Private) ■■■
'***********************************************************************************************
'* 処理名 :FP_GetMdbConnectionString
'* 機能 :MDB接続文字列の編集
'-----------------------------------------------------------------------------------------------
'* 返り値 :MDB接続文字列(String)
'* 引数 :Arg1 = MDBファイル名(String)
'* Arg2 = マイドキュメント配下のサブフォルダ(String)
'* Arg3 = ユーザーID(String)
'* Arg4 = パスワード(String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:マイドキュメント配下のサブフォルダを指定してMDB接続文字列を編集
'* 注意事項:
'***********************************************************************************************
Private Function FP_GetMdbConnectionString(ByVal strMDBName As String, _
ByVal strSubFolder As String, _
ByVal strUserId As String, _
ByVal strPassword As String) As String
'-------------------------------------------------------------------------------------------
Dim strPathname As String = My.Computer.FileSystem.SpecialDirectories.MyDocuments ' フォルダ
' サブフォルダ指定あり
If strSubFolder.Length <> 0 Then
strPathname = Path.Combine(strPathname, strSubFolder)
End If
' MDBファイル名を接続したフルパス名を編集
Dim strFilename As String = Path.Combine(strPathname, strMDBName) ' ファイル名
' MDBの接続文字列を編集
Dim strConnectionString As String = g_cnsMDB_Connect1 ' 接続文字列
strConnectionString &= strFilename & g_cnsSCCOL
' ユーザーIDが指定されている
If strUserId.Length <> 0 Then
strConnectionString &= "User ID='" & strUserId & g_cnsSCCOL
End If
' パスワードが指定されている
If strPassword.Length <> 0 Then
strConnectionString &= "Password='" & strPassword & g_cnsSCCOL
End If
Return strConnectionString
End Function
'***********************************************************************************************
'* 処理名 :FP_ChangeRoundBrackets
'* 機能 :鍵カッコを丸カッコに変換(共通処理)
'-----------------------------------------------------------------------------------------------
'* 返り値 :変換後文字列(String)
'* 引数 :Arg1 = 変換前文字列(String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月22日
'* 更新者 :井上 治
'* 機能説明:例:"[TableName]"を"(TableName)"に変換する(例外メッセージ表示用)
'* 注意事項:先頭文字が"["でない場合はそのまま返す
'***********************************************************************************************
Private Function FP_ChangeRoundBrackets(ByVal strInTableName As String) As String
'-------------------------------------------------------------------------------------------
Const cnsKOKA2 As String = "].["
Const cnsDOT As String = "."
If strInTableName.Length = 0 Then Return strInTableName
' 先頭文字が"["か
If strInTableName.StartsWith(g_cnsKA2) Then
' 中間の"].["を"."のみに変換
Dim strText As String = strInTableName.Replace(cnsKOKA2, cnsDOT)
' 先頭文字が"["の場合は丸カッコに変換する
Return g_cnsKA & strText.Substring(1, strText.Length - 2) & g_cnsKO
ElseIf strInTableName.StartsWith(g_cnsKA) Then
' 先頭文字が"("の場合はそのまま返す
Return strInTableName
ElseIf strInTableName.EndsWith(g_cnsKO2) Then
' 右端のみ"]"が付いている場合の対応
Dim strText As String = strInTableName.Substring(0, strInTableName.Length - 1)
Return g_cnsKA & strText & g_cnsKO
Else
' 上記以外の場合は"("~")"で挟む
Return g_cnsKA & strInTableName & g_cnsKO
End If
End Function
'----------------------------------------<< End of Source >>------------------------------------
End Class
'***************************************************************************************************
' サンプル用DataGridView制御関連定数・変数 modAboutDataGridView1(Module)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' ※この下に「DataGridView制御関連クラス(clsAboutDataGridView3)」があります
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/01/15(1.0.0.0)新規作成
'***************************************************************************************************
Module modAboutDataGridView1
'===============================================================================================
' DataGridViewの位置
Friend Const g_cnsDG_ML As DataGridViewContentAlignment = DataGridViewContentAlignment.MiddleLeft
Friend Const g_cnsDG_MC As DataGridViewContentAlignment = DataGridViewContentAlignment.MiddleCenter
Friend Const g_cnsDG_MR As DataGridViewContentAlignment = DataGridViewContentAlignment.MiddleRight
' DataGridViewのSortOrder
Friend Const g_cnsSO_Ascending As SortOrder = Windows.Forms.SortOrder.Ascending
Friend Const g_cnsSO_Descending As SortOrder = Windows.Forms.SortOrder.Descending
Friend Const g_cnsSO_None As SortOrder = Windows.Forms.SortOrder.None
' DataGridViewのSortMode
Friend Const g_cnsSM_Programmatic As DataGridViewColumnSortMode = _
DataGridViewColumnSortMode.Programmatic
Friend Const g_cnsSM_NotSortable As DataGridViewColumnSortMode = _
DataGridViewColumnSortMode.NotSortable
'-----------------------------------------------------------------------------------------------
' DataGridViewのカラム設定用ユーザー定義
Friend Structure g_typDGVColInfo
Dim dgvCaption As String ' 見出し表示名
Dim dgvWidth As Integer ' カラム表示幅
Dim dgvAlign As DataGridViewContentAlignment ' 水平配置
Dim dgvSortMode As DataGridViewColumnSortMode ' Sortモード
End Structure
'----------------------------------------<< End of Source >>------------------------------------
End Module
'***************************************************************************************************
' サンプル用DataGridView制御関連クラス clsAboutDataGridView3(Class)
'
' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
' 変更日付 Rev 変更履歴内容-------------------------------------------------------------------->
' 17/01/15(1.0.0.0)新規作成
' 17/02/05(1.0.3.0)「追加行へのスクロール移動(ScrollToAddedRow)」の追加
'***************************************************************************************************
Friend Class clsAboutDataGridView3
'***********************************************************************************************
' ■■■ DataGridView関連共通サブ処理 ■■■
'***********************************************************************************************
'* 処理名 :SetColumnInfo
'* 機能 :DataGridViewのカラム情報テーブル登録
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = カラム情報テーブル(Array:g_typDGVColInfo)
'* Arg2 = 見出し表示文字列(String)
'* Arg3 = カラム表示幅(Integer)
'* Arg4 = 水平配置(DataGridViewContentAlignment) ※Option
'* Arg5 = Sortモード(DataGridViewColumnSortMode) ※Option
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:カラム情報の見出し名、表示幅、配置、Sortモードをカラム順にセット
'* 注意事項:INDEXは順次加算されるのでテーブルはデフォルトをNothingとする
'***********************************************************************************************
Friend Sub SetColumnInfo(ByRef DGVColInfo() As g_typDGVColInfo, _
ByVal Caption As String, _
ByVal Width As Integer, _
Optional ByVal Align As DataGridViewContentAlignment = g_cnsDG_ML, _
Optional ByVal SortMode As DataGridViewColumnSortMode = _
DataGridViewColumnSortMode.Automatic)
'-------------------------------------------------------------------------------------------
' テーブル要素を追加
Dim intIx As Integer = 0 ' テーブルINDEX
' 既にテーブルが作成済みか
If DGVColInfo IsNot Nothing Then
' [作成済]要素を追加
intIx = DGVColInfo.Length
ReDim Preserve DGVColInfo(intIx)
Else
' [未作成]初期化
ReDim DGVColInfo(intIx)
End If
'-------------------------------------------------------------------------------------------
' テーブルに追加
With DGVColInfo(intIx)
.dgvCaption = Caption ' 見出し表示名
.dgvWidth = Width ' カラム表示幅
.dgvAlign = Align ' 水平配置
.dgvSortMode = SortMode ' Sortモード
End With
End Sub
'***********************************************************************************************
'* 処理名 :GetDefaultColumnWidth
'* 機能 :カラム情報テーブルよりカラム幅一次テーブルを作成
'-----------------------------------------------------------------------------------------------
'* 返り値 :カラム幅一次テーブル(Array:Integer)
'* 引数 :Arg1 = カラム情報テーブル(Array:g_typDGVColInfo)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:「列リセット」用カラム幅一次テーブルを作成する
'* 注意事項:
'***********************************************************************************************
Friend Function GetDefaultColumnWidth(ByRef DGVColInfo() As g_typDGVColInfo) As Integer()
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = 0 ' テーブルINDEX
Dim intIxMax As Integer = DGVColInfo.GetUpperBound(0) ' テーブルINDEX上限
Dim tblDefaultColumnWidth(intIxMax) As Integer ' カラム情報テーブルWORK
' 全件繰り返す
Do While intIx <= intIxMax
tblDefaultColumnWidth(intIx) = DGVColInfo(intIx).dgvWidth
' 次へ
intIx += 1
Loop
Return tblDefaultColumnWidth.Clone
End Function
'***********************************************************************************************
'* 処理名 :GP_AdjustColumnWidth
'* 機能 :カラム情報テーブルのカラム幅再調整
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = カラム情報テーブル(Array:g_typDGVColInfo)
'* Arg2 = 設定文字列(String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:列幅の配列を設定退避値で置き換える
'* 注意事項:
'***********************************************************************************************
Friend Sub AdjustColumnWidth(ByRef DGVColInfo() As g_typDGVColInfo, _
ByVal strSettingString As String)
'-------------------------------------------------------------------------------------------
' 設定退避値が登録済みか
If ((strSettingString IsNot Nothing) AndAlso (strSettingString.Length <> 0)) Then
' 設定文字列を配列に変換(セパレータはTab)
Dim tblWidth2() As String = strSettingString.Split(ControlChars.Tab) ' 一時テーブル
' 配列要素の一致を確認
If ((DGVColInfo.Length > 2) AndAlso (tblWidth2.Length > 2)) Then
Dim intIx As Integer = 0 ' テーブルINDEX
Dim intIxMax As Integer = DGVColInfo.GetUpperBound(0) ' テーブルINDEX上限
' 設定値で配列を置き換える
If tblWidth2.GetUpperBound(0) < intIxMax Then
intIxMax = tblWidth2.GetUpperBound(0)
End If
' 全件繰り返す
Do While intIx <= intIxMax
DGVColInfo(intIx).dgvWidth = Integer.Parse(tblWidth2(intIx).Trim)
' 次へ
intIx += 1
Loop
End If
End If
End Sub
'***********************************************************************************************
'* 処理名 :InitDataGridView1
'* 機能 :DataGridViewの初期設定(一般一覧用)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = DataGridView(Object)
'* Arg2 = カラム情報テーブル(Array:g_typDGVColInfo)
'* Arg3 = 固定見出し列INDEX(Integer) ※Option(デフォルト:-1)
'* Arg4 = 見出し高さ(Integer) ※Option(デフォルト:20)
'* Arg5 = 選択モード(DGVSelectionMode) ※Option(デフォルト:FullRow)
'* Arg6 = 読み取り専用(Boolean) ※Option(デフォルト:True)
'* Arg7 = 列幅変更可否(Boolean) ※Option(デフォルト:True)
'* Arg8 = 列位置変更可否(Boolean) ※Option(デフォルト:True)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub InitDataGridView1(ByRef objDGV As DataGridView, _
ByRef DGVColInfo() As g_typDGVColInfo, _
Optional ByVal FrozenColIndex As Integer = -1, _
Optional ByVal ColumnHeadersHeight As Integer = 20, _
Optional ByVal SelectionMode As DataGridViewSelectionMode = _
DataGridViewSelectionMode.FullRowSelect, _
Optional ByVal blnReadOnly As Boolean = True, _
Optional ByVal AllowUserToResizeColumns As Boolean = True, _
Optional ByVal AllowUserToOrderColumns As Boolean = True)
'-------------------------------------------------------------------------------------------
Dim intIx As Integer = 0 ' テーブルINDEX
Dim intIxMax As Integer = DGVColInfo.GetUpperBound(0) ' テーブルINDEX上限
'-------------------------------------------------------------------------------------------
' ForeColor、BackColorの調整
Dim objBackColor As Color = Color.FromArgb(240, 240, 240)
Dim objForeColor As Color = Color.Green
'-------------------------------------------------------------------------------------------
' DataGridViewの初期設定
With objDGV
.AutoSize = False ' 自動サイズ無し(固定)
.AllowUserToResizeColumns = AllowUserToResizeColumns ' 列幅変更可否
.AllowUserToOrderColumns = AllowUserToOrderColumns ' 列位置変更可否
.AllowUserToResizeRows = False ' 行高変更不可(固定)
.EnableHeadersVisualStyles = False ' Visualスタイルを使用しない(固定)
.RowHeadersVisible = False ' 行見出し有無
.ColumnHeadersVisible = True ' 列見出し有無
.ReadOnly = blnReadOnly ' 読み取り専用
.ColumnHeadersHeightSizeMode = _
DataGridViewColumnHeadersHeightSizeMode.DisableResizing ' (固定)
With .ColumnHeadersDefaultCellStyle
.Alignment = DataGridViewContentAlignment.MiddleCenter ' (固定)
.BackColor = objBackColor ' 列見出し背景色
.ForeColor = objForeColor ' 列見出し文字色
End With
.ColumnHeadersHeight = ColumnHeadersHeight ' 列見出し高さ
.SelectionMode = SelectionMode ' 選択モード
.MultiSelect = False ' 複数選択
.ColumnCount = intIxMax + 1 ' 列数
' 各列の設定
Do While intIx <= intIxMax
With .Columns(intIx)
.Width = DGVColInfo(intIx).dgvWidth
.HeaderText = DGVColInfo(intIx).dgvCaption
.AutoSizeMode = DataGridViewAutoSizeColumnMode.None
.DefaultCellStyle.Alignment = DGVColInfo(intIx).dgvAlign
.SortMode = DGVColInfo(intIx).dgvSortMode
End With
' 次列へ
intIx += 1
Loop
If FrozenColIndex >= 0 Then
.Columns(FrozenColIndex).Frozen = True ' 設定列で列固定
End If
End With
End Sub
'***********************************************************************************************
'* 処理名 :AdjustDGVColumnDisplayIndex
'* 機能 :DataGridViewのカラム配置再調整
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = DataGridView(Object)
'* Arg2 = 設定文字列(String)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:列配置を設定退避値で置き換える
'* 注意事項:
'***********************************************************************************************
Friend Sub AdjustDGVColumnDisplayIndex(ByRef objDGV As DataGridView, _
ByVal strSettingString As String)
'-------------------------------------------------------------------------------------------
If ((strSettingString IsNot Nothing) AndAlso (strSettingString.Length <> 0)) Then
' 設定文字列を配列に変換(セパレータはTab)
Dim tblDisplayIndexS() As String = strSettingString.Split(ControlChars.Tab) ' WORK
Dim intIxMax As Integer = tblDisplayIndexS.GetUpperBound(0) ' テーブルINDEX上限
Dim tblDisplayIndex(intIxMax) As Integer ' 設定値テーブル
Dim tblIndex(intIxMax) As Integer ' 位置テーブル
Dim intIx As Integer = 0 ' テーブルINDEX
Do While intIx <= intIxMax
tblDisplayIndex(intIx) = Integer.Parse(tblDisplayIndexS(intIx).Trim)
tblIndex(intIx) = intIx
' 次へ
intIx += 1
Loop
' 表示順の若い方からセットするために並替え
Array.Sort(tblDisplayIndex, tblIndex)
' DataGridView
With objDGV
' カラム数調整
If intIxMax >= .Columns.Count Then
intIxMax = .Columns.Count - 1
End If
intIx = 0
' 全列を巡回
Do While intIx <= intIxMax
' 位置が上限以内
If tblIndex(intIx) <= intIxMax Then
.Columns(tblIndex(intIx)).DisplayIndex = intIx
End If
' 次列へ
intIx += 1
Loop
End With
End If
End Sub
'***********************************************************************************************
'* 処理名 :GetDGVColumnWidth
'* 機能 :DataGridViewのカラム幅の取得
'-----------------------------------------------------------------------------------------------
'* 返り値 :設定退避用に文字列(String)
'* 引数 :Arg1 = DataGridView(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:DataGridViewのカラム幅を設定退避用に文字列で取得
'* 注意事項:
'***********************************************************************************************
Friend Function GetDGVColumnWidth(ByRef objDGV As DataGridView) As String
'-------------------------------------------------------------------------------------------
Dim strTEXT As String = String.Empty ' テキストWORK
Dim intIx As Integer = 1 ' テーブルINDEX
' DataGridView
With objDGV
strTEXT = .Columns(0).Width.ToString
' 全列の幅をTabを挟んで接合
Do While intIx < .Columns.Count
strTEXT &= ControlChars.Tab & .Columns(intIx).Width.ToString
' 次へ
intIx += 1
Loop
End With
Return strTEXT
End Function
'***********************************************************************************************
'* 処理名 :GetDGVColumnDisplayIndex
'* 機能 :DataGridViewのカラム配置の取得
'-----------------------------------------------------------------------------------------------
'* 返り値 :設定退避用に文字列(String)
'* 引数 :Arg1 = DataGridView(Object)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:DataGridViewのカラム配置を設定退避用に文字列で取得
'* 注意事項:
'***********************************************************************************************
Friend Function GetDGVColumnDisplayIndex(ByRef objDGV As DataGridView) As String
'-------------------------------------------------------------------------------------------
Dim strTEXT As String = String.Empty ' テキストWORK
Dim intIx As Integer = 1 ' テーブルINDEX
' DataGridView
With objDGV
strTEXT = .Columns(0).DisplayIndex.ToString
' 全列の表示順INDEXをTabを挟んで接合
Do While intIx < .Columns.Count
strTEXT &= ControlChars.Tab & .Columns(intIx).DisplayIndex.ToString
' 次へ
intIx += 1
Loop
End With
Return strTEXT
End Function
'***********************************************************************************************
'* 処理名 :DGV_ColumnHeaderMouseClick
'* 機能 :グリッド見出しクリック(ColumnHeaderMouseClick)
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :(デフォルト)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年01月15日
'* 作成者 :井上 治
'* 更新日 :2017年01月15日
'* 更新者 :井上 治
'* 機能説明:SortMode.Programmatic列を含む一覧の並替えを行なう
'* 注意事項:Programmatic列は実Sort列IndexをTagにセットしておくこと
'***********************************************************************************************
Friend Sub DGV_ColumnHeaderMouseClick(ByVal sender As Object, _
ByVal e As DataGridViewCellMouseEventArgs)
'-------------------------------------------------------------------------------------------
With CType(sender, DataGridView)
Dim intCol As Integer = e.ColumnIndex ' カラムINDEX
If .Columns(intCol).SortMode = g_cnsSM_Programmatic Then
'-----------------------------------------------------------------------------------
' 当該カラムがProgrammaticに場合は指定列でSort
Dim intCol2 As Integer = .Columns(intCol).Tag ' カラムINDEX
If .Columns(intCol).HeaderCell.SortGlyphDirection = g_cnsSO_Ascending Then
' 降順に並替え及びソートマーク切替え
.Sort(.Columns(intCol2), System.ComponentModel.ListSortDirection.Descending)
.Columns(intCol).HeaderCell.SortGlyphDirection = g_cnsSO_Descending
Else
' 昇順に並替え及びソートマーク切替え
.Sort(.Columns(intCol2), System.ComponentModel.ListSortDirection.Ascending)
.Columns(intCol).HeaderCell.SortGlyphDirection = g_cnsSO_Ascending
End If
' 他のProgrammatic列のソートマークを消す
For Each objCol As DataGridViewColumn In .Columns
If ((objCol.SortMode = g_cnsSM_Programmatic) AndAlso _
(objCol.Index <> intCol)) Then
objCol.HeaderCell.SortGlyphDirection = g_cnsSO_None
End If
Next objCol
Else
'-----------------------------------------------------------------------------------
' 当該カラムがProgrammaticでない場合は全Programmatic列のソートマークを消す
For Each objCol As DataGridViewColumn In .Columns
If objCol.SortMode = g_cnsSM_Programmatic Then
objCol.HeaderCell.SortGlyphDirection = g_cnsSO_None
End If
Next objCol
End If
End With
End Sub
'***********************************************************************************************
'* 処理名 :ScrollToAddedRow
'* 機能 :追加行へのスクロール移動
'-----------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数 :Arg1 = DataGridView(Object)
'* Arg2 = 追加された行INDEX(Integer)
'-----------------------------------------------------------------------------------------------
'* 作成日 :2017年02月05日
'* 作成者 :井上 治
'* 更新日 :2017年02月05日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***********************************************************************************************
Friend Sub ScrollToAddedRow(ByRef objDGV As DataGridView, _
ByVal intNewRow As Integer)
'-------------------------------------------------------------------------------------------
' 追加行が画面内の場合は何もしない
If ((intNewRow < 0) OrElse (objDGV.Rows(intNewRow).Displayed)) Then Exit Sub
Dim intLastRow As Integer = objDGV.Rows.Count - 1 ' 最終行
' 追加行が最終行でない場合は何もしない
If intNewRow <> intLastRow Then Exit Sub
With objDGV
' 画面に何行分表示できるかをカウント(可変行高は不対応)
Dim intCntRow As Integer = 0 ' 表示可能行数
Dim intRow As Integer = .FirstDisplayedScrollingRowIndex ' 表示先頭行INDEX
' 下へ向かって各行が表示可能かを確認
Do While intRow <= intLastRow
' 現在行が表示されているか
If .Rows(intRow).Displayed Then
intCntRow += 1
Else
Exit Do
End If
' 次の行へ
intRow += 1
Loop
' 表示可能行数が取得できない場合は何もしない
If intCntRow = 0 Then Exit Sub
' 一部表示でもDisplayedになることの対応と最終行認識のため空行を表示させるため2行調整
intRow = intNewRow - intCntRow + 2
' 先頭判定(念のため!)
If intRow < 0 Then intRow = 0
' その行にスクロールさせる
.FirstDisplayedScrollingRowIndex = intRow
' 追加行を選択状態にする
.Rows(intNewRow).Selected = True
End With
End Sub
'----------------------------------------<< End of Source >>------------------------------------
End Class
Private Const g_cnsMDB_Connect1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"
'Private Const g_cnsMDB_Connect1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" ' ←ACCDBの場合
' MDBファイル情報
Private Const g_cnsMdbFileame As String = "SampleCorp1.mdb"
'Private Const g_cnsMdbFileame As String = "SampleCorp1.accdb" ' ←ACCDBの場合