AccessVBA クラスオブジェクト③大会出品用印刷メイン

Option Compare Database
‘印刷対象のレポート名の変数を定義
Dim RepotMei As String
Dim RepotMei2 As String

Private Sub cmbレポート選択_Enter()
Me.cmbレポート選択.RowSourceType = “Table/Query”
Me.cmbレポート選択.ColumnCount = 2
Me.cmbレポート選択.RowSource = “SELECT レポート名 FROM tb帳票名 WHERE レポート名 LIKE ‘大会出品*’;”
End Sub

Private Sub cmbレポート選択2_Enter()
Me.cmbレポート選択2.RowSourceType = “Table/Query”
Me.cmbレポート選択2.ColumnCount = 2
Me.cmbレポート選択2.RowSource = “SELECT レポート名 FROM tb帳票名 WHERE レポート名 LIKE ‘大会出品*’;”
End Sub

Private Sub flTorihikisakiSentaku_AfterUpdate()

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

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:
End Sub

Sub Form_Open(Cancel As Integer)
‘変数を定義、商品ID・指値の値を空にする。
Dim s As Variant, N As Variant

s = “”: N = “”

‘フォームのテキストボックスの値を空にする。
Me.txtTorihikisaki.Value = “”
Me.txtDaimoku.Value = “”
Me.txtSyuppinTuki.Value = “”
Me.txtSyuppinNen.Value = “”
Me.txtSakuseiHi.Value = “”

‘フォルダの場所の規定値を表示
Me.txtフォルダパス.Value = “C:\Users\golive\Desktop\Access_BackUp”
‘出品用データの過去分のテーブルリストを表示する
Me.listTableName.RowSourceType = “Table/Query”
Me.listTableName.RowSource = “tb大会出品テーブルリスト”
Me.listTableName.ColumnCount = 2

FormSizeWide4
Me.PictureType = 0
Me.Picture = BgImageDataPath
End Sub

Private Sub listTableName_DblClick(Cancel As Integer)
Me.txt市場出品テーブル名.Value = Me.listTableName.Column(1)
End Sub

Private Sub listTorihikisaki_DblClick(Cancel As Integer)
‘売上先リストを選択、ダブルクリックで売却先コード・売却先名を値としてコントロールが取得する。
Me.txtTorihikisaki.Value = Me.listTorihikisaki.Column(1)
Me.txtDaimoku.SetFocus
End Sub

Private Sub エクスポートボタン_Click()

Dim ListName As String
ListName = Nz(Me.txt市場出品テーブル名.Value, “”)

If ListName = “” Then
MsgBox “確認する取引データを右のリストより選択してください。”
Else
‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_大会出品商品一覧.xlsx”

‘フォルダの場所をフォームより取得
Dim FolderPath As String
FolderPath = Me.txtフォルダパス.Value

‘フォルダパス+ファイル名
Dim FilePath As String
FilePath = FolderPath & “\” & FileName

‘エクスポートするソースのテーブルを指定
TaikaiTableName = Me.txt市場出品テーブル名.Value

‘エクスポート
Call XLSExport(TaikaiTableName, FilePath)
‘メッセージ表示
MsgBox comMsg0017
End If
End Sub

Private Sub ステータス変更ボタン_Click()

On Error GoTo err_Shori

Dim ID() As String, I As Long, j As Long

‘新規作成したテーブル[TaikaiTableName]より、登録した商品コードを配列で取得
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset
Dim SQL As String

Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rrs = New ADODB.Recordset

rs.Open TaikaiTableName, cn, adOpenKeyset, adLockOptimistic
I = 0
j = rs.RecordCount – 1
ReDim ID(j)

rs.MoveFirst
Do Until rs.EOF
ID(I) = Nz(rs!ID, “”)
I = I + 1
rs.MoveNext
Loop

‘取得した商品コードで、[tb商品一覧]より抽出する為のクエリを作成し、商品ステータスの値を変更
SQL = “SELECT * FROM tb商品一覧 WHERE 商品コード = ‘” & ID(0) & “‘”
For I = 1 To j
SQL = SQL & ” OR 商品コード = ‘” & ID(I) & “‘”
Next I

SQL = SQL & “;”

rrs.Open SQL, cn, adOpenKeyset, adLockOptimistic

rrs.MoveFirst
Do Until rrs.EOF
rrs.Update “ステータス”, “市場出品中”
rrs.MoveNext
Loop

‘登録完了のメッセージ
MsgBox rs.RecordCount & “件の” & comMsg0001
rrs.Close: rs.Close: cn.Close
Set rrs = Nothing: Set rs = Nothing: Set cn = Nothing
‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub 印刷プレビューボタン_Click()

‘大会出品用レポートのクエリのソース（”仮tb_大会出品_個別入力用”）に新規作成したテーブル（TaikaiTableName）のレコードを代入
taikaiReportData (TaikaiTableName)
‘印刷プレビュー
DoCmd.OpenReport “r大会出品用_出品用”, acViewPreview, , , acDialog
DoCmd.OpenReport “r大会出品用_保存版”, acViewPreview, , , acDialog
MsgBox “問題なければ[印刷]ボタンを押してください。”, vbInformation
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fmメインメニュー”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 印刷ボタン_Click()
RepotMei = Me.cmbレポート選択.Value
If InStr(RepotMei, “保存”) Then
DoCmd.OpenReport “r大会出品用_保存版”, acViewNormal, , , acWindowNormal
ElseIf InStr(RepotMei, “提出”) Then
DoCmd.OpenReport “r大会出品用_出品用”, acViewNormal, , , acWindowNormal
Else
MsgBox “印刷するレポート名が選択されていません。”

End If

End Sub

Private Sub 過去出品分印刷ボタン_Click()
RepotMei2 = Me.cmbレポート選択2.Value
If InStr(RepotMei2, “保存”) Then
DoCmd.OpenReport “r大会出品用_保存版”, acViewNormal, , , acWindowNormal, TaikaiTesuryou
ElseIf InStr(RepotMei2, “提出”) Then
DoCmd.OpenReport “r大会出品用_出品用”, acViewNormal, , , acWindowNormal
Else
MsgBox “印刷するレポート名が選択されていません。”

End If
End Sub

Private Sub 過去出品分確認ボタン_Click()

Dim ListName As String
ListName = Nz(Me.txt市場出品テーブル名.Value, “”)

If ListName = “” Then
MsgBox “確認する出品データを右のリストより選択してください。”

Else
‘大会出品用レポートのクエリのソース（”仮tb_大会出品_個別入力用”）に選択したテーブルのレコードを代入
TaikaiTableName = ListName
taikaiReportData (TaikaiTableName)
‘選択したテーブル名より、取引先、題目、出品年月、作成日も取得
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open “tb大会出品テーブルリスト”, cn
rs.Filter = “大会出品テーブル名 = ‘” & TaikaiTableName & “‘”
If rs.RecordCount <> 0 Then
Taikai_Torihikisaki = rs!大会_取引先
Taikai_Nengetu = rs!大会_出品年月
Taikai_Daimoku = rs!大会_題目
Taikai_Sakuseibi = rs!大会_作成日
‘ TaikaiTesuryou = rs!手数料
End If
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

‘印刷プレビュー
DoCmd.OpenReport “r大会出品用_出品用”, acViewPreview, , , acDialog
DoCmd.OpenReport “r大会出品用_保存版”, acViewPreview, , , acDialog
MsgBox “問題なければ[印刷]ボタンを押してください。”, vbInformation
End If

End Sub

Private Sub 過去出品分編集ボタン_Click()
MsgBox TaikaiTableName & “を編集します。”
Application.Echo False ‘画面の描画を止める
OpenForm (“fm大会出品_個別編集用”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 参照ボタン_Click()
Me.txtフォルダパス.Value = FDFolderPicker
End Sub

Private Sub 手数料登録ボタン_Click()
MsgBox TaikaiTableName & “の手数料を登録します。”
Application.Echo False ‘画面の描画を止める
‘選択したテーブル名より、テキストボックスに入力した手数料をフィールドに追加
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open “tb大会出品テーブルリスト”, cn, adOpenKeyset, adLockOptimistic
rs.Filter = “大会出品テーブル名 = ‘” & TaikaiTableName & “‘”
If rs.RecordCount <> 0 Then
rs.Fields(“手数料”).Value = Me.txt手数料.Value
rs.Update
TaikaiTesuryou = rs.Fields(“手数料”).Value

Debug.Print rs.Fields(“手数料”).Value
End If
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 出品用商品入力フォームボタン_Click()
‘メインフォーム入力情報の値渡し
‘ Taikai_Torihikisaki = Me.txtTorihikisaki.Value
‘ Taikai_Nengetu = Me.txtSyuppinTuki.Value & “年” & Me.txtSyuppinTuki.Value & “月”
‘ Taikai_Daimoku = Me.txtDaimoku.Value
‘ Taikai_Sakuseibi = Me.txtSakuseiHi.Value
‘フォーム切り替え
Application.Echo False ‘画面の描画を止める
OpenForm (“fm大会出品_個別入力用”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う

End Sub

Private Sub 商品管理へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm商品管理”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 新規データ作成ボタン_Click()
‘新規デーブル作成し、移動先の個別入力用フォームの連結テーブルとする
‘**************************テーブル命名規則*******************************
‘**
‘**　○年○月_取引先名_現在時刻
‘**
‘**　　　・取引先名からは()を__に変換、㈱を_株_に変換する
‘**
‘**************************************************************************
On Error GoTo Err

TaikaiTableName = “”

‘新規テーブル名の作成
Taikai_Torihikisaki = Me.txtTorihikisaki.Value
Taikai_Nengetu = Me.txtSyuppinNen.Value & “年” & Me.txtSyuppinTuki.Value & “月”
TaikaiTableName = Replace(Taikai_Torihikisaki, “㈱”, “_株_”)
TaikaiTableName = Replace(TaikaiTableName, “㈲”, “_有_”)
TaikaiTableName = Replace(TaikaiTableName, “(“, “_”)
TaikaiTableName = Replace(TaikaiTableName, “)”, “_”)
TaikaiTableName = Replace(TaikaiTableName, ” “, “”)
TaikaiTableName = Replace(TaikaiTableName, “　”, “”)
TaikaiTableName = “tbT” & “_” & Taikai_Nengetu & “_” & TaikaiTableName

‘新規テーブル名が既存テーブルと重複している場合、アラートを出す。

‘既存テーブルが不要な場合は、[tb大会出品テーブルリスト]からデータを削除、テーブルも削除する。

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Dim Strmsg As String
Strmsg = “同じ名前のテーブルが存在します。” & vbCrLf & “[” & TaikaiTableName & “]を削除しますか?”

rs.Open “tb大会出品テーブルリスト”, cn, adOpenKeyset, adLockOptimistic
rs.Filter = “大会出品テーブル名 = ‘” & TaikaiTableName & “‘”
If rs.RecordCount <> 0 Then
If MsgBox(Strmsg, vbOKCancel + vbExclamation) = vbOK Then
rs.Delete
DoCmd.RunSQL “DROP TABLE ” & TaikaiTableName

MsgBox “既存のテーブルを削除し、[tb大会出品テーブルリスト]からもデータを削除しました。”

Else
MsgBox “テーブル作成処理をキャンセルします。”
GoTo Exit_終了
End If

End If

rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing

‘DAOで新規テーブル作成
Dim db As DAO.Database
Dim tb As DAO.TableDef
Dim ind As DAO.Index
Dim fld As DAO.Field
Set db = CurrentDb
Set tb = db.CreateTableDef(TaikaiTableName)

‘作成したテーブルにフィールドを追加
‘空欄NGのフィールド
tb.Fields.Append tb.CreateField(“グループ”, dbText, 10)
tb.Fields.Append tb.CreateField(“No”, dbLong, 10)
‘空欄OK、値要求不要のフィールド
Set fld = tb.CreateField(“ID”, dbText, 10)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“商品名”, dbText, 50)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“カテゴリ”, dbText, 20)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“金性”, dbText, 20)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“特徴”, dbText, 50)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“数”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“付属品_備考”, dbText, 30)
fld.AllowZeroLength = True
fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“指値_税抜”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“LV上代価格”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“原価_税抜”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“原価_税込”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

Set fld = tb.CreateField(“売価_税抜”, dbLong, 10)
‘ fld.AllowZeroLength = True
‘ fld.Required = False
tb.Fields.Append fld

db.TableDefs.Append tb

Set tb = Nothing: Set db = Nothing

‘新規テーブル名、付属情報を[tb大会出品テーブルリスト]に追加する

Taikai_Daimoku = Me.txtDaimoku.Value
Taikai_Sakuseibi = Me.txtSakuseiHi.Value

DoCmd.SetWarnings False
Dim strSql As String
strSql = “INSERT INTO tb大会出品テーブルリスト(大会出品テーブル名,大会_取引先,大会_題目,大会_出品年月,大会_作成日) ” _
& “VALUES(‘” & TaikaiTableName & “‘,'” & Taikai_Torihikisaki & “‘,'” & Taikai_Daimoku & “‘,'” & Taikai_Nengetu & “‘,'” & Taikai_Sakuseibi & “‘);”

DoCmd.RunSQL strSql

DoCmd.SetWarnings True

MsgBox “新規テーブル：[” & TaikaiTableName & “]を作成し、大会出品用テーブルリストに追加しました。”

Exit_終了:
Exit Sub
Err:
MsgBox Err.Description
Resume Exit_終了
End Sub

Private Sub 帳票印刷画面へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm帳票印刷”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 編集ボタン_Click()
MsgBox TaikaiTableName & “を編集します。”
Application.Echo False ‘画面の描画を止める
OpenForm (“fm大会出品_個別編集用”)
CloseForm (“fm大会出品用印刷メイン3”)
Application.Echo True ‘画面の描画を行う

End Sub