AccessVBA クラスオブジェクト②商品編集

Option Compare Database

Private Sub cmbブランドコード_AfterUpdate()

Me.txtブランド.Value = Me.cmbブランドコード.Column(1)

End Sub

Private Sub cmb取引先コード_AfterUpdate()
Me.txt取引先名.Value = Me.cmb取引先コード.Column(0)

End Sub

Private Sub cmb商品分類コード_AfterUpdate()
Me.txt商品分類.Value = Me.cmb商品分類コード.Column(1)

End Sub

Private Sub cmb売却先コード_AfterUpdate()
Me.txt売却先名.Value = Me.cmb売却先コード.Column(0)

End Sub

Private Sub cmb品番_AfterUpdate()
Me.txtライン.Value = Me.cmb品番.Column(1)

End Sub

Private Sub flBaikyakusakiSentaku_AfterUpdate()

‘***************************************************************************
‘*
‘*　カナ選択で、候補のリストを表示、選択できるようにする
‘*
‘***************************************************************************
Dim strSql As String, MySQL As String
Dim KanaList As Variant

Select Case Me.flBaikyakusakiSentaku.Value
Case Me.op1.OptionValue
KanaList = Array(“ア”, “イ”, “ウ”, “エ”, “オ”)
Case Me.op2.OptionValue
KanaList = Array(“カ”, “キ”, “ク”, “ケ”, “コ”, “ガ”, “ギ”, “グ”, “ゲ”, “ゴ”)
Case Me.op3.OptionValue
KanaList = Array(“サ”, “シ”, “ス”, “セ”, “ソ”, “ザ”, “ジ”, “ズ”, “ゼ”, “ゾ”)
Case Me.op4.OptionValue
KanaList = Array(“タ”, “チ”, “ツ”, “テ”, “ト”, “ダ”, “ヂ”, “ヅ”, “デ”, “ド”)
Case Me.op5.OptionValue
KanaList = Array(“ナ”, “ニ”, “ヌ”, “ネ”, “ノ”)
Case Me.op6.OptionValue
KanaList = Array(“ハ”, “ヒ”, “フ”, “ヘ”, “ホ”, “バ”, “ビ”, “ブ”, “ベ”, “ボ”, “パ”, “ピ”, “プ”, “ペ”, “ポ”)
Case Me.op7.OptionValue
KanaList = Array(“マ”, “ミ”, “ム”, “メ”, “モ”)
Case Me.op8.OptionValue
KanaList = Array(“ヤ”, “ユ”, “ヨ”)
Case Me.op9.OptionValue
KanaList = Array(“ラ”, “リ”, “ル”, “レ”, “ロ”)
Case Me.op10.OptionValue
KanaList = Array(“ワ”, “オ”, “ン”)
Case Me.op11.OptionValue
GoTo Filter_End
Case Else
MsgBox “取引先名の先頭の文字が選択されていません”
End Select

MySQL = “(カナ LIKE ‘” & KanaList(0) & “*’) ”
Select Case Me.flBaikyakusakiSentaku.Value
Case 1, 5, 7, 9
For I = 1 To 4
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 2, 3, 4
For I = 1 To 9
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 6
For I = 1 To 14
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 8, 10
For I = 1 To 2
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case Else
End Select

strSql = “SELECT 売却先コード,売却先名,カナ FROM tb売上先マスタ WHERE ” & MySQL & “ORDER BY カナ;”

‘カナ昇順で並べ替え付与し、リストのソース指定
Me.listBaikyakusaki.RowSource = strSql
Me.listBaikyakusaki.Requery
GoTo List_End

Filter_End:
Me.listBaikyakusaki.RowSource = “SELECT 売却先コード,売却先名,カナ FROM tb売上先マスタ ORDER BY 売却先コード;”
List_End:
End Sub

Private Sub flTorihikisakiSentaku_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.flTorihikisakiSentaku.Value
Case Me.op1.OptionValue
KanaList = Array(“ア”, “イ”, “ウ”, “エ”, “オ”)
Case Me.op2.OptionValue
KanaList = Array(“カ”, “キ”, “ク”, “ケ”, “コ”, “ガ”, “ギ”, “グ”, “ゲ”, “ゴ”)
Case Me.op3.OptionValue
KanaList = Array(“サ”, “シ”, “ス”, “セ”, “ソ”, “ザ”, “ジ”, “ズ”, “ゼ”, “ゾ”)
Case Me.op4.OptionValue
KanaList = Array(“タ”, “チ”, “ツ”, “テ”, “ト”, “ダ”, “ヂ”, “ヅ”, “デ”, “ド”)
Case Me.op5.OptionValue
KanaList = Array(“ナ”, “ニ”, “ヌ”, “ネ”, “ノ”)
Case Me.op6.OptionValue
KanaList = Array(“ハ”, “ヒ”, “フ”, “ヘ”, “ホ”, “バ”, “ビ”, “ブ”, “ベ”, “ボ”, “パ”, “ピ”, “プ”, “ペ”, “ポ”)
Case Me.op7.OptionValue
KanaList = Array(“マ”, “ミ”, “ム”, “メ”, “モ”)
Case Me.op8.OptionValue
KanaList = Array(“ヤ”, “ユ”, “ヨ”)
Case Me.op9.OptionValue
KanaList = Array(“ラ”, “リ”, “ル”, “レ”, “ロ”)
Case Me.op10.OptionValue
KanaList = Array(“ワ”, “ヲ”, “ン”)
Case Me.op11.OptionValue
GoTo Filter_End
Case Else
MsgBox “取引先名の先頭の文字が選択されていません”
End Select

MySQL = “(カナ LIKE ‘” & KanaList(0) & “*’) ”
Select Case Me.flTorihikisakiSentaku.Value
Case 1, 5, 7, 9
For I = 1 To 4
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 2, 3, 4
For I = 1 To 9
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 6
For I = 1 To 14
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case 8, 10
For I = 1 To 2
MySQL = MySQL & “OR (カナ LIKE ‘” & KanaList(I) & “*’) ”

Next
Case Else
End Select

strSql = “SELECT 取引先コード,取引先名,カナ FROM tb取引先マスタ WHERE ” & MySQL & “ORDER BY カナ;”

‘カナ昇順で並べ替え付与し、リストのソース指定
Me.listTorihikisaki.RowSource = strSql
Me.listTorihikisaki.Requery
GoTo List_End

Filter_End:
Me.listTorihikisaki.RowSource = “SELECT 取引先コード,取引先名,カナ FROM tb取引先マスタ ORDER BY 取引先コード;”

List_End:

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
err_Shori:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Private Sub Form_Load()
Dim ID As String
ID = “”
Me.txtSID.Value = ID
Me.listTorihikisaki.RowSource = “”
Me.listBaikyakusaki.RowSource = “”
End Sub

Private Sub Form_Open(Cancel As Integer)
FormSizeSquare2
Me.PictureType = 0
Me.Picture = BgImageDataPath
End Sub

Private Sub listBaikyakusaki_DblClick(Cancel As Integer)
Me.cmb売却先コード.Value = Me.listBaikyakusaki.Column(0)
Me.txt売却先名.Value = Me.listBaikyakusaki.Column(1)
End Sub

Private Sub listTorihikisaki_DblClick(Cancel As Integer)
Me.cmb取引先コード.Value = Me.listTorihikisaki.Column(0)
Me.txt取引先名.Value = Me.listTorihikisaki.Column(1)
End Sub

Private Sub TOPへ戻るボタン_Click()

‘ If Me.Dirty = True Then ‘カレントレコードが変更されている場合
‘
‘ lRes = MsgBox(“保存しますか？”, vbYesNo + vbQuestion, “確認”)
‘
‘ If lRes = vbYes Then
‘ DoCmd.RunCommand acCmdSaveRecord
‘ Else
‘ Me.Undo
‘ End If
‘
‘ End If

OpenMain
CloseForm (“fm商品編集2”)

End Sub

Private Sub txt税抜原価_AfterUpdate()
Me.txt税込原価.Value = Fix(Me.txt税抜原価.Value * 1.08)

End Sub

Private Sub txt税抜売価_AfterUpdate()
Me.txt税込売価.Value = Fix(Me.txt税抜売価.Value * 1.08)
End Sub

Private Sub 画面内用をクリアボタン_Click()
‘全てのコントロールの表示を空にする
Dim ctl As Control
On Error Resume Next

For Each ctl In Me.Controls
ctl.Value = “”
Next ctl
Me.listTorihikisaki.RowSource = “”
Me.listBaikyakusaki.RowSource = “”
End Sub

Private Sub 更新ボタン_Click()

‘On Error GoTo err_Shori

‘クエリ更新
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL1 As String, SQL2 As String

Set cn = CurrentProject.Connection
Set rs1 = New ADODB.Recordset
Set rs2 = New ADODB.Recordset

ID = Me.txtSID.Value
SQL1 = “SELECT * FROM tb商品一覧 WHERE 商品コード = ‘” & ID & “‘;”
SQL2 = “SELECT * FROM tb商品売上一覧 WHERE 商品コード = ‘” & ID & “‘;”
rs1.Open SQL1, cn, adOpenKeyset, adLockOptimistic
rs2.Open SQL2, cn, adOpenKeyset, adLockOptimistic

With Me
rs1.Update “ステータス”, .cmbステータス.Value
rs1.Update “仕入日”, .txt仕入日.Value
rs1.Update “取引先コード”, Format(CInt(.cmb取引先コード.Value), “000000”)
rs1.Update “買番号”, .txt買番号.Value
rs1.Update “商品分類コード”, Format(CInt(.cmb商品分類コード.Value), “000”)
‘rs1.Update “ブランドコード”, Format(CInt(.cmbブランドコード.Value), “00000”)
rs1.Update “品番”, .cmb品番.Value
rs1.Update “商品名”, .txt商品名.Value
rs1.Update “素材”, .txt素材.Value
rs1.Update “色”, .txt色.Value
rs1.Update “付属品”, .txt付属品.Value
rs1.Update “シリアルNo”, .txtシリアルNo.Value
rs1.Update “ランク”, .cmbランク.Value
rs1.Update “予定_税抜売価”, .txt予定_税抜売価.Value
rs1.Update “税抜定価”, .txt税抜定価.Value
rs1.Update “備考”, .txt備考.Value
rs1.Update “税抜原価”, .txt税抜原価.Value
rs2.Update “売却日”, .txt売却日.Value
rs2.Update “税抜売価”, .txt税抜売価.Value

End With
‘登録完了のメッセージ
MsgBox comMsg0001
rs1.Close: rs2.Close: cn.Close
Set rs1 = Nothing: Set rs2 = Nothing: Set cn = Nothing

‘全てのコントロールの表示を空にする
Dim ctl As Control

On Error Resume Next

‘ For Each ctl In Me.Controls
‘ With ctl
‘ If .ControlType = acTextBox Then
‘ ‘コントロールの種類がテキストボックスなら値をNull（空）に設定
‘ .Value = “”
‘ End If
‘ End With
‘ ctl.Value = “”
‘ Next ctl

‘終了処理
err_Exit:
Exit Sub

‘エラー処理
‘err_Shori:
‘ MsgBox “Number : ” & Err.Number & vbCr & _
‘ “Source : ” & Err.Source & vbCr & _
‘ “Description : ” & Err.Description
‘ Err.Clear
‘ Resume err_Exit:
‘
End Sub

Private Sub 商品管理画面へ戻るボタン_Click()

CloseForm (“fm商品編集2”)
OpenForm (“fm商品管理”)

End Sub

Private Sub 抽出ボタン_Click()
‘************************************************************************
‘ フォームに入力された商品コードで商品データを抽出、
‘　　編集モードで抽出したレコードセット内容を表示（非連結）
‘
‘************************************************************************
On Error GoTo err_Shori

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset

ID = Me.txtSID.Value
SQL = “SELECT * FROM q商品一覧 WHERE 商品コード = ‘” & ID & “‘;”

rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

With Me
.txt商品コード.Value = rs!商品コード
.cmbステータス.Value = rs!ステータス
.txt仕入日.Value = rs!仕入日
.cmb取引先コード.Value = rs!取引先コード
.txt取引先名.Value = rs!取引先名
.txt買番号.Value = rs!買番号
.cmb商品分類コード.Value = rs!商品分類コード
.txt商品分類.Value = rs!商品分類
.cmbブランドコード.Value = rs!ブランドコード
.txtブランド.Value = rs!ブランド
.cmb品番.Value = rs!品番
.txtライン.Value = rs!ライン
.txt商品名.Value = rs!商品名
.txt素材.Value = rs!素材
.txt色.Value = rs!色
.txt付属品.Value = rs!付属品
.txtシリアルNo.Value = rs!シリアルNo
.cmbランク.Value = rs!ランク
.txt予定_税抜売価.Value = rs!予定_税抜売価
.txt税抜定価.Value = rs!税抜定価
.txt備考.Value = rs!備考
.txt税抜原価.Value = rs!税抜原価
.txt税込原価.Value = rs!税込原価
.txt売却日.Value = rs!売却日
.txt税抜売価.Value = rs!税抜売価
.txt税込売価.Value = rs!税込売価
.txt売却先名.Value = rs!売却先名
.cmb売却先コード.Value = rs!売却先コード