AccessのDBファイルを長期的に安定して使用するには

①データベースの分割

https://support.office.com/ja-jp/article/access-データベースを分割する-3015ad18-a3a1-4e9c-a7f3-51b1d73498cc?ui=ja-JP&rs=ja-JP&ad=JP
↓↓↓↓↓
・フロントエンドファイル
・バックエンドファイル

②定期的なデータベースの最適化と修復

ps://support.office.com/ja-jp/article/データベースを最適化および修復する-6ee60f16-aed0-40ac-bf22-85fa9f4005b2?ui=ja-JP&rs=ja-JP&ad=JP
※バックエンドファイルのみ

③定期式なバックアップ

・VBAでコーディング
https://www.moug.net/tech/acvba/0070012.html
・バックアップソフトを使用（フリーのBunBackup）
https://hatenachips.blog.fc2.com/blog-entry-122.html

④必要に応じてリフレッシュ

新規のデータベースファイルを作成する。
そこに現在使用中のデータベースファイルからすべてのオプジェクトをインポートする。

※フロントエンドファイルのみ

レポートで空の行を印刷することで、印刷開始行をずらす

①レポートのデータソースとなる仮テーブルの先頭に空の行を挿入

②空のデータ行は最後に印刷されるため、レポートでの並び順を変更する
▼操作手順：レポートでのレコードの並び順を指定する
レポートをデザインビューで開く
↓
メニュー［表示］−［並べ替え/グループ化の設定］をクリック
↓
［並べ替え/グループ化］ダイアログ-［フィールド/式］欄でフィールドを指定
↓
［並べ替え/グループ化］ダイアログ-［並べ替え順序］欄で「昇順」または「降順」を指定
↓
［並べ替え/グループ化］ダイアログ-［閉じる］ボタンをクリック
※［並べ替え/グループ化］で並び順を指定していない場合、レコードがどんな順序で印刷されるかは不定となってしまいます。

③データが空の場合に線をひかないようにするには、
線を、テキストボックスで表示し、FLG（ボックスの値：Value）が0の時は、
可視化プロパティ（Visible）をfalseにする。

Option Compare Database

Private Sub Form_Open(Cancel As Integer)
FormSizeSquare
Me.PictureType = 0
Me.Picture = BgImageDataPath
‘フォルダの場所の規定値を表示
Me.txtフォルダパス.Value = “C:\Users\golive\Desktop\Access_BackUp”

‘バックアップ履歴のリストを表示
Me.バックアップ履歴リスト.ColumnCount = 3
Me.バックアップ履歴リスト.RowSourceType = “Table/Query”
Me.バックアップ履歴リスト.RowSource = “tbバックアップ履歴”
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenMain
CloseForm (“fmバックアップ”)
Application.Echo True ‘画面の描画を行う
End Sub
———————————————————————————————-
Private Sub バックアップ処理ボタン_Click()

On Error GoTo err_Shori:

‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_backup.accdb”

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

‘バックアップ処理
Dim BU As Boolean
BU = BackUpFile(FolderPath, FileName)
‘バックアップ処理をキャンセルする場合
If Not BU Then
Exit Sub
End If

‘バックアップ作成ボタン押下時点での時間を取得
Dim UpdateTime As String
UpdateTime = Format(Now, “yyyy/mm/dd_hh:nn”)

‘バックアップ履歴を残す（tbバックアップにデータ追加処理）

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open “tbバックアップ履歴”, cn, adOpenKeyset, adLockOptimistic
‘RS.MoveLast
‘レコード件数の抽出
Dim I As Long, j As Long, k As String, No As String
I = rs.RecordCount
I = Nz(I, “0”)
‘自動連番の表示桁数を取得
For j = 1 To 8
k = k + “0”
Next j
‘番号の更新
I = I + 1

‘振番
No = Format(CInt(I), k)
With rs
.AddNew
.Fields(0).Value = No
.Fields(1).Value = UpdateTime
.Fields(2).Value = FileName
.Update
.MoveNext
End With
MsgBox “バックアップデータの更新履歴を追加しました。”

‘終了処理
err_Exit:
Exit Sub

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

End Sub

———————————————————————————————-
Private Sub 更新ボタン_Click()
Me.バックアップ履歴リスト.RowSource = “tbバックアップ履歴”
End Sub
———————————————————————————————-
Private Sub 参照ボタン_Click()
Me.txtフォルダパス.Value = FDFolderPicker

End Sub

Option Compare Database
Dim zanNuki As Long, zanKomi As Long
‘zan1 As Long, zan2 As Long, zan3 As Long, zan4 As Long, zan5 As Long, zan6 As Long, zan7 As Long, zan8 As Long, zan9 As Long, zan10 As Long
‘zan11 As Long, zan12 As Long, zan13 As Long, zan14 As Long, zan15 As Long, zan16 As Long, zan17 As Long, zan18 As Long, zan19 As Long, zan20 As Long

Private Sub Excelへエクスポートボタン_Click()
On Error GoTo err_Shori

‘[仮_tb在庫商品一覧]のテーブルの既存データをクリアにし、新たに在庫一覧のデータを格納する。
TableClear (“仮_tb在庫商品一覧”)

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Dim ID As Variant, Baika As Variant, I As Long
Dim sqlName As String, SQL As String
Dim strFilter1 As String
Dim strFilter2 As String

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

SQL = “SELECT * FROM q商品一覧 WHERE ”
strFilter1 = “ステータス = ‘在庫'”
strFilter2 = “ステータス=’Yahoo!出品中'”
strFilter3 = “ステータス=’楽天出品中'”
strFilter4 = “ステータス=’業者出品中'”
strFilter5 = “ステータス=’市場出品中'”

sqlName = strFilter1 & ” Or ” & strFilter2 & ” Or ” & strFilter3 & ” Or ” & strFilter4 & ” Or ” & strFilter5
SQL = SQL & sqlName & “;”
rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

rrs.Open “仮_tb在庫商品一覧”, cn, adOpenKeyset, adLockOptimistic

MsgBox rs.RecordCount & “件のデータを抽出します。”

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

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

MsgBox “抽出が完了しました。”

‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_在庫商品一覧.xlsx”
‘出力先のパス（ファイル名まで含む）
Dim Path As String
Path = Me.txtPath.Value
‘テーブルをエクセルでエクスポート
Call ExcelExport(Path, FileName, “仮_tb在庫商品一覧”)

‘終了処理
err_Exit:
Exit Sub

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

End Sub

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

‘*********************在庫金額（税抜）を表示させる’*********************
zan1 = DSum(“税抜原価”, “tb商品一覧”, “ステータス=’在庫'”)
zan2 = DSum(“税抜原価”, “tb商品一覧”, “ステータス=’Yahoo!出品中'”)
zan3 = DSum(“税抜原価”, “tb商品一覧”, “ステータス=’楽天出品中'”)
zan4 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “ステータス=’業者出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “ステータス=’業者出品中'”))
zan5 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “ステータス=’市場出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “ステータス=’市場出品中'”))
zanNuki = zan1 + zan2 + zan3 + zan4 + zan5
‘ zanNuki = zanNuki – DSum(“評価損”, “q評価損一覧_仮”)

With Me
.txt在庫額_税抜き.Value = zanNuki
.txtZ1.Value = zan1
.txtZ2.Value = zan2
.txtZ3.Value = zan3
.txtZ4.Value = zan4
.txtZ5.Value = zan5
End With

”*********************在庫金額（税込）を表示させる’*********************
zanKomi = DSum(“税込原価”, “q商品一覧”, “ステータス=’在庫'”)
zanKomi = zanKomi + DSum(“税込原価”, “q商品一覧”, “ステータス=’Yahoo!出品中'”)
zanKomi = zanKomi + DSum(“税込原価”, “q商品一覧”, “ステータス=’楽天出品中'”)
zanKomi = zanKomi + IIf(IsNull(DSum(“税込原価”, “q商品一覧”, “ステータス=’業者出品中'”)), 0, DSum(“税込原価”, “q商品一覧”, “ステータス=’業者出品中'”))
zanKomi = zanKomi + IIf(IsNull(DSum(“税込原価”, “q商品一覧”, “ステータス=’市場出品中'”)), 0, DSum(“税込原価”, “q商品一覧”, “ステータス=’市場出品中'”))
‘ zanKomi = zanKomi – DSum(“評価損”, “q評価損一覧_仮”)

Me.txt在庫額_税込み.Value = zanKomi

”*********************預かり消費税額を表示させる’*********************
Me.txt預かり消費税.Value = zanKomi – zanNuki

”*********************商品カテゴリ別在庫金額（税抜）を表示させる’*********************
zan11 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’在庫'”))
zan11 = zan11 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’Yahoo!出品中'”))
zan11 = zan11 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’001′” & ” And ステータス=’楽天出品中'”))

zan12 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’在庫'”))
zan12 = zan12 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’Yahoo!出品中'”))
zan12 = zan12 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’002′” & ” And ステータス=’楽天出品中'”))

zan13 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’在庫'”))
zan13 = zan13 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’Yahoo!出品中'”))
zan13 = zan13 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’003′” & ” And ステータス=’楽天出品中'”))

zan14 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’在庫'”))
zan14 = zan14 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’Yahoo!出品中'”))
zan14 = zan14 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’004′” & ” And ステータス=’楽天出品中'”))

zan15 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’在庫'”))
zan15 = zan15 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’Yahoo!出品中'”))
zan15 = zan15 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’005′” & ” And ステータス=’楽天出品中'”))

zan16 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’在庫'”))
zan16 = zan16 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’Yahoo!出品中'”))
zan16 = zan16 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’006′” & ” And ステータス=’楽天出品中'”))

zan17 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’在庫'”))
zan17 = zan17 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’Yahoo!出品中'”))
zan17 = zan17 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’007′” & ” And ステータス=’楽天出品中'”))

zan18 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’在庫'”))
zan18 = zan18 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’Yahoo!出品中'”))
zan18 = zan18 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’008′” & ” And ステータス=’楽天出品中'”))

zan19 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’在庫'”))
zan19 = zan19 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’Yahoo!出品中'”))
zan19 = zan19 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’009′” & ” And ステータス=’楽天出品中'”))

zan20 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’在庫'”))
zan20 = zan20 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’Yahoo!出品中'”))
zan20 = zan20 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “商品分類コード=’012′” & ” And ステータス=’楽天出品中'”))

zan21 = zanNuki – zan11 – zan12 – zan13 – zan14 – zan15 – zan16 – zan17 – zan18 – zan19 – zan20

With Me
.txtZ11.Value = zan11
.txtZ12.Value = zan12
.txtZ13.Value = zan13
.txtZ14.Value = zan14
.txtZ15.Value = zan15
.txtZ16.Value = zan16
.txtZ17.Value = zan17
.txtZ18.Value = zan18
.txtZ19.Value = zan19
.txtZ20.Value = zan20
.txtZ21.Value = zan21
End With

”*********************入荷時期別在庫金額（税抜）を表示させる’*********************
‘過去の日付をとる
day_hanToshi = DateAdd(“m”, -6, Date) ‘半年前
day_1nen = DateAdd(“yyyy”, -1, Date) ‘1年前
day_2nen = DateAdd(“yyyy”, -2, Date) ‘2年前
day_3nen = DateAdd(“yyyy”, -3, Date) ‘3年前

zan6 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’在庫'”))
zan6 = zan6 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’Yahoo!出品中'”))
zan6 = zan6 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_hanToshi & “# And ステータス=’楽天出品中'”))

zan7 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’在庫'”))
zan7 = zan7 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’Yahoo!出品中'”))
zan7 = zan7 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_1nen & “# And ステータス=’楽天出品中'”))
zan7 = zan7 – zan6

zan8 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’在庫'”))
zan8 = zan8 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’Yahoo!出品中'”))
zan8 = zan8 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_2nen & “# And ステータス=’楽天出品中'”))
zan8 = zan8 – zan7 – zan6

zan9 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’在庫'”))
zan9 = zan9 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’Yahoo!出品中'”))
zan9 = zan9 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 >= #” & day_3nen & “# And ステータス=’楽天出品中'”))
zan9 = zan9 – zan8 – zan7 – zan6

zan10 = IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’在庫'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’在庫'”))
zan10 = zan10 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’Yahoo!出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’Yahoo!出品中'”))
zan10 = zan10 + IIf(IsNull(DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’楽天出品中'”)), 0, DSum(“税抜原価”, “tb商品一覧”, “仕入日 < #” & day_3nen & “# And ステータス=’楽天出品中'”))

zan11 = zanNuki – zan6 – zan7 – zan8 – zan9 – zan10

With Me
.txtZ6.Value = zan6
.txtZ7.Value = zan7
.txtZ8.Value = zan8
.txtZ9.Value = zan9
.txtZ10.Value = zan10
.txtZ22.Value = zan11
End With
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenMain
CloseForm (“fm在庫数表示”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 参照ボタン_Click()
Me.txtPath.Value = FDFolderPicker
End Sub

Private Sub 商品管理画面へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm商品管理”)
CloseForm (“fm在庫数表示”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 販売管理画面へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm販売管理”)
CloseForm (“fm在庫数表示”)
Application.Echo True ‘画面の描画を行う
End Sub

Option Compare Database

Private Sub Form_Open(Cancel As Integer)
FormSizeSquare
Me.PictureType = 0
Me.Picture = BgImageDataPath
‘フォルダの場所の規定値を表示
Me.txtフォルダパス.Value = “C:\Users\golive\Desktop\Access_BackUp”

‘バックアップ履歴のリストを表示
Me.バックアップ履歴リスト.ColumnCount = 3
Me.バックアップ履歴リスト.RowSourceType = “Table/Query”
Me.バックアップ履歴リスト.RowSource = “tbバックアップ履歴”
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenMain
CloseForm (“fmバックアップ”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub バックアップ処理ボタン_Click()

On Error GoTo err_Shori:

‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_backup.accdb”

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

‘バックアップ処理
Dim BU As Boolean
BU = BackUpFile(FolderPath, FileName)
‘バックアップ処理をキャンセルする場合
If Not BU Then
Exit Sub
End If

‘バックアップ作成ボタン押下時点での時間を取得
Dim UpdateTime As String
UpdateTime = Format(Now, “yyyy/mm/dd_hh:nn”)

‘バックアップ履歴を残す（tbバックアップにデータ追加処理）

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
rs.Open “tbバックアップ履歴”, cn, adOpenKeyset, adLockOptimistic
‘RS.MoveLast
‘レコード件数の抽出
Dim I As Long, j As Long, k As String, No As String
I = rs.RecordCount
I = Nz(I, “0”)
‘自動連番の表示桁数を取得
For j = 1 To 8
k = k + “0”
Next j
‘番号の更新
I = I + 1

‘振番
No = Format(CInt(I), k)
With rs
.AddNew
.Fields(0).Value = No
.Fields(1).Value = UpdateTime
.Fields(2).Value = FileName
.Update
.MoveNext
End With
MsgBox “バックアップデータの更新履歴を追加しました。”

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub 更新ボタン_Click()
Me.バックアップ履歴リスト.RowSource = “tbバックアップ履歴”
End Sub

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

End Sub

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

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

‘***************************************************************************
‘*
‘*　カナ選択で、候補のリストを表示、選択できるようにする
‘*
‘***************************************************************************
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:

‘終了処理
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!売却先コード

End With

MsgBox “データの編集をお願いします。完了後は、更新ボタンを押してください。”

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Option Compare Database
‘3つの条件の項目を代入する変数を定義
Dim F1 As String, F2 As String, F3 As String
‘取得した値を代入する変数を定義
Dim J1 As String, J2 As String, J3 As String, J4 As String
‘並べ替え条件の変数を定義
Dim MySort As String
‘テーブル名とフィールド名の変数を定義
Dim TableName As String, FieldName1 As String, FieldName2 As String, FieldName3 As String
Private Sub Excelへエクスポートボタン_Click()
On Error GoTo err_Shori

‘今日の日付でファイル名作成
Dim FileName As String
FileName = Format(Now, “yyyymmdd_hhnn”) & “_商品抽出一覧.xlsx”
‘出力先のパス（ファイル名まで含む）
Dim Path As String
Path = Me.txtPath.Value
‘テーブルをエクセルでエクスポート
Call ExcelExport(Path, FileName, “仮_tb商品検索一覧表用2”)

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub Form_Load()

F1 = “”: F2 = “”: F3 = “”

‘テキスト等を空にする
With Me
.txt商品コード.Value = “”
.txt仕入開始日.Value = “”
.txt仕入終了日.Value = “”
.txt売上開始日.Value = “”
.txt売上終了日.Value = “”
.txt仕入先コード.Value = “”
.txt売上先コード.Value = “”
.txtPath.Value = “C:\Users\golive\Desktop\Access_BackUp”
.cmbブランド.Value = “”
.cmb商品ステータス.Value = “”
.cmb商品分類.Value = “”
.list取引先.RowSource = “”
.txtコメント.Value = “”
.frame1.Value = “”
.frame2.Value = “”
.frame3.Value = “”
.frame取引先選択.Value = “”
End With

End Sub

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

Private Sub frame1_AfterUpdate()
On Error GoTo err_Shori

Select Case Me.frame1.Value
Case Me.opt1.OptionValue
‘条件の取得
F1 = “商品コード”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = False: Me.optb1.Enabled = False: Me.optc1.Enabled = False: Me.optd1.Enabled = False: Me.opte1.Enabled = False
Me.opta2.Enabled = False: Me.optb2.Enabled = False: Me.optc2.Enabled = False: Me.optd2.Enabled = False: Me.opte2.Enabled = False

Case Me.opt2.OptionValue
‘条件の取得
F1 = “商品分類”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = False: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = False: Me.optd2.Enabled = True: Me.opte2.Enabled = True

Case Me.opt3.OptionValue
‘条件の取得
F1 = “ブランド”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = False: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = False: Me.opte2.Enabled = True

Case Me.opt4.OptionValue
‘条件の取得
F1 = “ステータス”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = False
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = False

Case Me.opt5.OptionValue
‘条件の取得
F1 = “仕入日”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = True
Case Me.opt6.OptionValue
‘条件の取得
F1 = “売却日”
F2 = “”: F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opta1.Enabled = True: Me.optb1.Enabled = True: Me.optc1.Enabled = True: Me.optd1.Enabled = True: Me.opte1.Enabled = True
Me.opta2.Enabled = True: Me.optb2.Enabled = True: Me.optc2.Enabled = True: Me.optd2.Enabled = True: Me.opte2.Enabled = True
Case Else

End Select
‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub frame2_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame2.Value
Case Me.opta1.OptionValue
‘条件の取得
F2 = “取引先名”
F3 = “”
TableName = “tb取引先マスタ”
FieldName1 = “取引先コード”
FieldName2 = “取引先名”
FieldName3 = “カナ”
MsgBox “右側のリストより、仕入先名を選択し、ダブルクリックしてください。”
‘条件選択内容により、一部を選択不可とする
Me.opta2.Enabled = False
Me.txt仕入先コード.Enabled = True
Me.txtコメント.Value = “仕入先”

Case Me.optb1.OptionValue
‘条件の取得
F2 = “売却先名”
F3 = “”
MsgBox “右側のリストより、売上先名を選択し、ダブルクリックしてください。”
TableName = “tb売上先マスタ”
FieldName1 = “売却先コード”
FieldName2 = “売却先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.opta2.Enabled = True: Me.optb2.Enabled = False
Me.txt売上先コード.Enabled = True
Me.txtコメント.Value = “売上先”

Case Me.optc1.OptionValue
‘条件の取得
F2 = “商品分類”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.optc2.Enabled = False
Me.cmb商品分類.Enabled = True

Case Me.optd1.OptionValue
‘条件の取得
F2 = “ブランド”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.optd2.Enabled = False
Me.cmbブランド.Enabled = True

Case Me.opte1.OptionValue
‘条件の取得
F2 = “ステータス”
F3 = “”
‘条件選択内容により、一部を選択不可とする
Me.opte2.Enabled = False
Me.cmb商品ステータス.Enabled = True
Case Else

End Select

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub frame3_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame3.Value
Case Me.opta2.OptionValue
‘条件の取得
F3 = “取引先名”
MsgBox “右側のリストより、仕入先名を選択し、ダブルクリックしてください。”
TableName = “tb取引先マスタ”
FieldName1 = “取引先コード”
FieldName2 = “取引先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.txt仕入先コード.Enabled = True
Me.txtコメント.Value = “仕入先”

Case Me.optb2.OptionValue
‘条件の取得
F3 = “売却先名”
MsgBox “右側のリストより、売上先名を選択し、ダブルクリックしてください。”
TableName = “tb売上先マスタ”
FieldName1 = “売却先コード”
FieldName2 = “売却先名”
FieldName3 = “カナ”
‘条件選択内容により、一部を選択不可とする
Me.txt売上先コード.Enabled = True
Me.txtコメント.Value = “売上先”

Case Me.optc2.OptionValue
‘条件の取得
F3 = “商品分類”

‘条件選択内容により、一部を選択不可とする
Me.cmb商品分類.Enabled = True

Case Me.optd2.OptionValue
‘条件の取得
F3 = “ブランド”

‘条件選択内容により、一部を選択不可とする
Me.cmbブランド.Enabled = True

Case Me.opte2.OptionValue
‘条件の取得
F3 = “ステータス”

‘条件選択内容により、一部を選択不可とする
Me.cmb商品ステータス.Enabled = True

Case Else

End Select

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub frame4_AfterUpdate()

On Error GoTo err_Shori

Select Case Me.frame4.Value
Case Me.chk1.OptionValue
MySort = “仕入日”
Case Me.chk2.OptionValue
MySort = “売却日”
Case Me.chk3.OptionValue
MySort = “商品分類”
Case Me.chk4.OptionValue
MySort = “ブランド”
Case Me.chk5.OptionValue
MySort = “取引先名”
Case Me.chk6.OptionValue
MySort = “売却先名”
Case Me.chk7.OptionValue
MySort = “買番号”
Case Else
MySort = “商品コード”
End Select

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub frame取引先選択_AfterUpdate()
‘***************************************************************************
‘*
‘*　カナ選択で、候補のリストを表示、選択できるようにする
‘*
‘***************************************************************************

On Error GoTo err_Shori

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

Select Case Me.frame取引先選択.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.frame取引先選択.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 ” & FieldName1 & “,” & FieldName2 & “,” & FieldName3 & ” FROM ” & TableName & ” WHERE ” & MySQL & ” ORDER BY ” & FieldName3 & “;”

‘カナ昇順で並べ替え付与し、リストのソース指定
Me.list取引先.RowSource = strSql
Me.list取引先.Requery
Exit Sub

Filter_End:
Me.list取引先.ColumnCount = 3
Me.list取引先.RowSourceType = “Table/Query”
Me.list取引先.RowSource = “SELECT ” & FieldName1 & “,” & FieldName2 & “,” & FieldName3 & ” FROM ” & TableName & ” ORDER BY ” & FieldName2 & “;”

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub list取引先_DblClick(Cancel As Integer)
‘ダブルクリックで、仕入先名、売却先名を取得
If TableName = “tb売上先マスタ” Then
Me.txt売上先コード.Value = Me.list取引先.Column(1)

ElseIf TableName = “tb取引先マスタ” Then
Me.txt仕入先コード.Value = Me.list取引先.Column(1)

End If
End Sub

Private Sub TOPへ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenMain
CloseForm (“fm商品検索2”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub リセットボタン_Click()
F1 = “”: F2 = “”: F3 = “”
J1 = “”: J2 = “”: J3 = “”: J4 = “”
MySort = “”

‘テキスト等を空にする
With Me
.txt商品コード.Value = “”
.txt仕入開始日.Value = “”
.txt仕入終了日.Value = “”
.txt売上開始日.Value = “”
.txt売上終了日.Value = “”
.txt仕入先コード.Value = “”
.txt売上先コード.Value = “”
.cmbブランド.Value = “”
.cmb商品ステータス.Value = “”
.cmb商品分類.Value = “”
.list取引先.RowSource = “”
.txtコメント.Value = “”
.frame1.Value = “”
.frame2.Value = “”
.frame3.Value = “”
.frame取引先選択.Value = “”
End With
End Sub

Private Sub 一覧表示ボタン_Click()

On Error GoTo err_Shori

‘[仮_tb商品検索一覧表用2]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用2”)

Dim MySQL1 As String, MySQL2 As String
If Me.frame4.Value = 7 Then
‘<並べ替え条件が「買番号」の場合>ソートしたレコードセットを、[仮_tb商品検索一覧表用2]テーブルに再セットする

‘買番号で「-」の左側の桁数が１桁をセレクトし、テーブルに追加。
MySQL1 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Len(仮_tb商品検索一覧表用.買番号) = 1 ORDER BY 買番号;”
DoCmd.RunSQL MySQL1

‘買番号で「-」の左側の桁数が１桁以外をセレクトし、テーブルに追加。
MySQL2 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Len(仮_tb商品検索一覧表用.買番号) <> 1 ORDER BY 買番号;”
‘ MySQL2 = “INSERT INTO 仮_tb商品検索一覧表用2 SELECT * FROM 仮_tb商品検索一覧表用 WHERE Abs(InStr(仮_tb商品検索一覧表用.買番号,” – “)-1) <> 1 ORDER BY 買番号;”
DoCmd.RunSQL MySQL2

Else
‘<並べ替え条件が「買番号」以外の場合>ソートしたレコードセットを、[仮_tb商品検索一覧表用2]テーブルに再セットする
‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

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

‘カーソルロケーションのプロパティ変更
rs.CursorLocation = adUseClient
‘ソート
rs.Open “仮_tb商品検索一覧表用”, cn
rs.Sort = MySort

rrs.Open “仮_tb商品検索一覧表用2”, cn, adOpenKeyset, adLockOptimistic

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

rs.Close: rrs.Close: cn.Close
Set rs = Nothing: Set rrs = Nothing: Set cn = Nothing
End If

DoCmd.OpenReport “r仮_tb商品検索一覧表用2”, acViewReport, , , acDialog

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub 参照ボタン_Click()
Me.txtPath.Value = FDFolderPicker
End Sub

Private Sub 商品管理画面へ戻るボタン_Click()
Application.Echo False ‘画面の描画を止める
OpenForm (“fm商品管理”)
CloseForm (“fm商品検索2”)
Application.Echo True ‘画面の描画を行う
End Sub

Private Sub 全件表示ボタン_Click()

On Error GoTo err_Shori

‘ DoCmd.OpenReport “r商品一覧”, acViewReport, , , acDialog
‘[仮_tb商品検索一覧表用]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用2”)
‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Dim ID As Variant, Baika As Variant, I As Long

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

‘カーソルロケーションのプロパティ変更
rs.CursorLocation = adUseClient
‘開いてソートする
rs.Open “q商品一覧”, cn, adOpenKeyset, adLockOptimistic
rs.Sort = “商品コード”

‘[仮_tb商品検索一覧表用2]フィールドに値を追加します。
rrs.Open “仮_tb商品検索一覧表用2”, cn, adOpenKeyset, adLockOptimistic

MsgBox rs.RecordCount & “件のデータを表示します。”

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

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

DoCmd.OpenReport “r仮_tb商品検索一覧表用2”, acViewReport, , , acDialog

‘終了処理
err_Exit:
Exit Sub

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

End Sub

Private Sub 抽出ボタン_Click()

‘On Error GoTo err_Shori

‘3つの条件と、値を取得する
If F1 = “商品コード” Then
J1 = Me.txt商品コード.Value
ElseIf F1 = “商品分類” Then
J1 = Me.cmb商品分類.Column(1)
ElseIf F1 = “ブランド” Then
J1 = Me.cmbブランド.Column(1)
ElseIf F1 = “ステータス” Then
J1 = Me.cmb商品ステータス.Column(0)
ElseIf F1 = “仕入日” Then
J1 = Me.txt仕入開始日.Value
J2 = Me.txt仕入終了日.Value
ElseIf F1 = “売却日” Then
J1 = Me.txt売上開始日.Value
J2 = Me.txt売上終了日.Value
Else
MsgBox “第一条件が選択されていません。選択してください。”
End If

If F2 = “取引先名” Then
J3 = Me.txt仕入先コード.Value
ElseIf F2 = “売却先名” Then
J3 = Me.txt売上先コード.Value
ElseIf F2 = “商品分類” Then
J3 = Me.cmb商品分類.Column(1)
ElseIf F2 = “ブランド” Then
J3 = Me.cmbブランド.Column(1)
ElseIf F2 = “ステータス” Then
J3 = Me.cmb商品ステータス.Column(0)
End If

If F3 = “取引先名” Then
J4 = Me.txt仕入先コード.Value
ElseIf F3 = “売却先名” Then
J4 = Me.txt売上先コード.Value
ElseIf F3 = “商品分類” Then
J4 = Me.cmb商品分類.Column(1)
ElseIf F3 = “ブランド” Then
J4 = Me.cmbブランド.Column(1)
ElseIf F3 = “ステータス” Then
J4 = Me.cmb商品ステータス.Column(0)
End If

‘仮のテーブルを作成し、テーブルをダイアログで表示する

‘[仮_tb商品検索一覧表用]テーブルのデータを全件削除する
TableClear (“仮_tb商品検索一覧表用”)

‘レコードセットを作成
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rrs As ADODB.Recordset

Dim ID As Variant, Baika As Variant, I As Long
Dim sqlName As String, SQL As String

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

‘条件1について
SQL = “SELECT * FROM q商品一覧 WHERE ”
If F1 = “仕入日” Or F1 = “売却日” Then
J1 = Format(J1, “yyyy/mm/dd”)
J2 = Format(J2, “yyyy/mm/dd”)
sqlName = F1 & ” >= #” & J1 & “# AND ” & F1 & ” <= #” & J2 & “#”

Else
sqlName = F1 & ” = ‘” & J1 & “‘”
End If

‘条件2,3について
If F2 = “” Then
GoTo RSyutoku
Else
sqlName = sqlName & ” AND ” & F2 & ” = ‘” & J3 & “‘”
If F3 = “” Then
GoTo RSyutoku
Else
sqlName = sqlName & ” AND ” & F3 & ” = ‘” & J4 & “‘”

End If
End If

RSyutoku:

SQL = SQL & sqlName & “;”

rs.Open SQL, cn, adOpenKeyset, adLockOptimistic

‘[仮_tb商品検索一覧表用]フィールドに値を追加します。
rrs.Open “仮_tb商品検索一覧表用”, cn, adOpenKeyset, adLockOptimistic

MsgBox rs.RecordCount & “件のデータを抽出します。”

Do Until rs.EOF

With rrs
.AddNew
.Fields(0).Value = rs!商品コード
.Fields(1).Value = rs!ステータス
.Fields(2).Value = rs!仕入日
.Fields(3).Value = rs!取引先名
.Fields(4).Value = rs!買番号
.Fields(5).Value = rs!商品分類
.Fields(6).Value = rs!ブランド
.Fields(7).Value = rs!品番
.Fields(8).Value = rs!ライン
.Fields(9).Value = rs!商品名
.Fields(10).Value = rs!素材
.Fields(11).Value = rs!色
.Fields(12).Value = rs!付属品
.Fields(13).Value = rs!シリアルNo
.Fields(14).Value = rs!ランク
.Fields(15).Value = rs!予定_税抜売価
.Fields(16).Value = rs!税抜定価
.Fields(17).Value = rs!備考
.Fields(18).Value = rs!税抜原価
.Fields(19).Value = rs!税込原価
.Fields(20).Value = rs!売却日
.Fields(21).Value = rs!税抜売価
.Fields(22).Value = rs!税込売価
.Fields(23).Value = rs!売却先名
.Update
.MoveNext
End With

rs.MoveNext
I = I + 1
Loop

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

MsgBox “抽出が完了しました。”

‘終了処理
err_Exit:
Exit Sub

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

End Sub