Private WithEvents e As Application
Sub e_SheetSelectionChange(ByVal w As Object, ByVal target As Range)
If ToggleButton1.Value = False Then Exit Sub
If ActiveSheet.Name <> "受注入力" Then Exit Sub
r = target.Item(1).Row
TextBox47.Text = r ' 行
TextBox19.Text = w.Cells(r, 1).Value ' 受注日
TextBox53.Text = w.Cells(r, 2).Value ' 得意先コード
TextBox1.Text = w.Cells(r, 3).Value ' 得意先
TextBox52.Text = w.Cells(r, 4).Value ' 品目コード
TextBox2.Text = w.Cells(r, 5).Value ' 品名
TextBox3.Text = w.Cells(r, 6).Value ' 型式・サイズ
TextBox4.Text = w.Cells(r, 7).Value ' 工番
TextBox5.Text = w.Cells(r, 8).Value ' 数量
TextBox6.Text = w.Cells(r, 9).Value ' 単価
TextBox7.Text = w.Cells(r, 10).Value ' 金額
TextBox48.Text = w.Cells(r, 11).Value ' 注文番号
TextBox11.Text = w.Cells(r, 12).Value ' 納期
TextBox12.Text = w.Cells(r, 13).Value ' 備考
End Sub
' --------------------------------------------------------
' 受注入力
' --------------------------------------------------------
Private Sub CommandButton7_Click() ' クリア
Call TextBoxClear
Call TextBoxInitialize
End Sub
Private Sub CommandButton5_Click() ' 削除
If TextBox47.Text = "" Then
MsgBox "対象の行が選択されていません。"
Exit Sub
End If
' 確認
If MsgBox("本当に削除しますか？", vbYesNo) = vbNo Then Exit Sub
Set w = ThisWorkbook.Sheets("受注入力")
Set t = ThisWorkbook.Sheets("更新削除履歴")
' 最終行取得
r = 2
Do While t.Cells(r, 1).Value <> ""
r = r + 1
Loop
target_row = r
' 履歴へ複写
r = TextBox47.Text
t.Range("A" & target_row).Value = "削除" ' A列で最終行を把握しているので必須
t.Range("B" & target_row).Value = Format(Now, "yyyy/mm/dd")
t.Range("C" & target_row & ":S" & target_row).Value = w.Range("A" & r & ":Q" & r).Value
' 削除
w.Rows(r).Delete
TextBox47.Text = ""
MsgBox "削除しました。"
End Sub
Private Sub CommandButton6_Click() ' 更新
' チェック
If TextBox47.Text = "" Then
MsgBox "対象の行が選択されていません。"
Exit Sub
End If
If TextBox19.Text = "" Or TextBox4.Text = "" Then
MsgBox "入力が不足しています。"
Exit Sub
End If
Set w = ThisWorkbook.Sheets("受注入力")
Set t = ThisWorkbook.Sheets("更新削除履歴")
' 最終行取得
r = 2
Do While t.Cells(r, 1).Value <> ""
r = r + 1
Loop
target_row = r
' 履歴へ複写
r = TextBox47.Text
t.Range("A" & target_row).Value = "更新" ' A列で最終行を把握しているので必須
t.Range("B" & target_row).Value = Format(Now, "yyyy/mm/dd")
t.Range("C" & target_row & ":S" & target_row).Value = w.Range("A" & r & ":Q" & r).Value
' 書き込み
r = TextBox47.Text
w.Cells(r, 1).Value = TextBox19.Text ' 受注日
w.Cells(r, 2).Value = TextBox53.Text ' 得意先コード
w.Cells(r, 3).Value = TextBox1.Text ' 得意先
w.Cells(r, 4).Value = TextBox52.Text ' 品目コード
w.Cells(r, 5).Value = TextBox2.Text ' 品名
w.Cells(r, 6).Value = TextBox3.Text ' 型式・サイズ
w.Cells(r, 7).Value = TextBox4.Text ' 工番
w.Cells(r, 8).Value = TextBox5.Text ' 数量
w.Cells(r, 9).Value = TextBox6.Text ' 単価
w.Cells(r, 10).Value = TextBox7.Text ' 金額
w.Cells(r, 11).Value = TextBox48.Text ' 注文番号
w.Cells(r, 12).Value = TextBox11.Text ' 納期
w.Cells(r, 13).Value = TextBox12.Text ' 備考
MsgBox "更新しました。"
End Sub
Private Sub CommandButton8_Click() ' 登録/工番固定
RegisterOrder (False)
End Sub
Private Sub CommandButton1_Click() ' 登録
RegisterOrder (True)
End Sub
Sub RegisterOrder(countup_serial)
' 未定の内容もあるため登録時は受注日と工番のみ必須
If TextBox19.Text = "" Or TextBox4.Text = "" Then
MsgBox "入力が不足しています。"
Exit Sub
End If
Set w = ThisWorkbook.Sheets("受注入力")
' 行末
r = 2
Do While w.Cells(r, 1).Value <> ""
r = r + 1
Loop
' 書き込み
w.Cells(r, 1).Value = TextBox19.Text ' 受注日
w.Cells(r, 2).Value = TextBox53.Text ' 得意先コード
w.Cells(r, 3).Value = TextBox1.Text ' 得意先
w.Cells(r, 4).Value = TextBox52.Text ' 品目コード
w.Cells(r, 5).Value = TextBox2.Text ' 品名
w.Cells(r, 6).Value = TextBox3.Text ' 型式
w.Cells(r, 7).Value = TextBox4.Text ' 工番
w.Cells(r, 8).Value = TextBox5.Text ' 数量
w.Cells(r, 9).Value = TextBox6.Text ' 単価
w.Cells(r, 10).Value = TextBox7.Text ' 金額
w.Cells(r, 11).Value = TextBox48.Text ' 注文番号
w.Cells(r, 12).Value = TextBox11.Text ' 納入日
w.Cells(r, 13).Value = TextBox12.Text ' 備考
' 工番
Sheets("設定").Range("A2") = TextBox4.Text
If countup_serial = True Then TextBox4.Text = CLng(TextBox4.Text) + 1
' アクティブ
w.Activate
w.Range("A" & r & ":Q" & r).Select
End Sub
Private Sub MultiPage1_Change()
End Sub
Private Sub TextBox21_Change()
' 得意先マスタ
ListBox1.Clear
Set w = Sheets("得意先マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
If InStr(LCase(w.Cells(r, 2).Value), LCase(TextBox21.Text)) > 0 Then
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = w.Cells(r, 1).Value ' 得意先コード
End If
r = r + 1
Loop
End Sub
Private Sub ListBox1_Click() ' 得意先マスタ
TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
TextBox53.Text = ListBox1.List(ListBox1.ListIndex, 1)
End Sub
Private Sub TextBox20_Change()
' 品名型式マスタ
ListBox2.Clear
Set w = Sheets("品名・型式マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
If InStr(LCase(w.Cells(r, 2).Value & " " & w.Cells(r, 3).Value), LCase(TextBox20.Text)) > 0 Then
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox2.List(ListBox2.ListCount - 1, 1) = w.Cells(r, 3).Value
ListBox2.List(ListBox2.ListCount - 1, 2) = w.Cells(r, 4).Value
ListBox2.List(ListBox2.ListCount - 1, 3) = w.Cells(r, 1).Value ' 品目コード
End If
r = r + 1
Loop
End Sub
Private Sub ListBox2_Click() ' 品名型式マスタ
TextBox2.Text = ListBox2.List(ListBox2.ListIndex, 0)
TextBox3.Text = ListBox2.List(ListBox2.ListIndex, 1)
TextBox6.Text = ListBox2.List(ListBox2.ListIndex, 2)
TextBox52.Text = ListBox2.List(ListBox2.ListIndex, 3) ' 品目コード
TotalAmount ' 単価が変わるため呼ぶ
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 数量
If IsNumeric(TextBox5.Text) Then
TextBox5.Text = CDec(TextBox5.Text)
Else
TextBox5.Text = ""
End If
Call TotalAmount
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 単価
If IsNumeric(TextBox6.Text) Then
TextBox6.Text = Format(CDec(TextBox6.Text), "#,###")
Else
TextBox6.Text = ""
End If
Call TotalAmount
End Sub
Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 金額
' 手入力する場合
If IsNumeric(TextBox7.Text) Then
TextBox7.Text = Format(CDec(TextBox7.Text), "#,###")
Else
TextBox7.Text = ""
End If
End Sub
Sub TotalAmount()
On Error GoTo exception
TextBox7.Text = Format(CDec(TextBox5.Text) * CDec(TextBox6.Text), "#,###") ' 数量×単価
Exit Sub
exception:
TextBox7.Text = ""
End Sub
Private Sub TextBox19_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 受注日
If IsDate(TextBox19.Text) Then
TextBox19.Text = Format(TextBox19.Text, "yyyy/mm/dd")
Else
TextBox19.Text = ""
End If
End Sub
Private Sub TextBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 納入日
If IsDate(TextBox11.Text) Then
TextBox11.Text = Format(TextBox11.Text, "yyyy/mm/dd")
Else
TextBox11.Text = ""
End If
End Sub
' --------------------------------------------------------
' 出荷予定表
' --------------------------------------------------------
Private Sub CommandButton2_Click()
If TextBox22.Text = "" Then Exit Sub
If TextBox23.Text = "" Then Exit Sub
Call create_shipping(TextBox22.Text, TextBox23.Text)
End Sub
Private Sub TextBox22_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox22.Text) Then
TextBox22.Text = Format(TextBox22.Text, "yyyy/mm/dd")
Else
TextBox22.Text = ""
End If
End Sub
Private Sub TextBox23_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox23.Text) Then
TextBox23.Text = Format(TextBox23.Text, "yyyy/mm/dd")
Else
TextBox23.Text = ""
End If
End Sub
' --------------------------------------------------------
' 工数入力
' --------------------------------------------------------
Private Sub CommandButton3_Click()
' チェック
chk = True
If TextBox37.Text = "" Then chk = False ' 登録日
If TextBox54.Text = "" Then chk = False ' 得意先コード
If TextBox32.Text = "" Then chk = False ' 得意先
If TextBox55.Text = "" Then chk = False ' 品名コード
If TextBox31.Text = "" Then chk = False ' 品名
If TextBox30.Text = "" Then chk = False ' 型式・サイズ
If TextBox29.Text = "" Then chk = False ' 工番
If ComboBox1.Text = "" Then chk = False ' 作業者
If TextBox33.Text = "" Then chk = False ' 作業日
If TextBox34.Text = "" Then chk = False ' 工数
If ComboBox2.Text = "" Then chk = False ' 作業内容
If False = chk Then
MsgBox "入力に不足があります。"
Exit Sub
End If
Set w = Sheets("工数入力")
' 行末
r = 2
Do While w.Cells(r, 1).Value <> ""
r = r + 1
Loop
' 書き込み
w.Cells(r, 1).Value = TextBox37.Text ' 登録日
w.Cells(r, 2).Value = TextBox54.Text ' 得意先コード
w.Cells(r, 3).Value = TextBox32.Text ' 得意先
w.Cells(r, 4).Value = TextBox55.Text ' 品名コード
w.Cells(r, 5).Value = TextBox31.Text ' 品名
w.Cells(r, 6).Value = TextBox30.Text ' 型式・サイズ
w.Cells(r, 7).Value = TextBox29.Text ' 工番
w.Cells(r, 8).Value = ComboBox1.Text ' 作業者
w.Cells(r, 9).Value = TextBox33.Text ' 作業日
w.Cells(r, 10).Value = TextBox34.Text ' 工数
w.Cells(r, 12).Value = TextBox35.Text ' 備考
' 作業内容
If ComboBox2.Text = "その他" Then
w.Cells(r, 11).Value = TextBox36.Text
If w.Cells(r, 11).Value = "" Then w.Cells(r, 11).Value = "その他"
Else
w.Cells(r, 11).Value = ComboBox2.Text
End If
' アクティブ
w.Activate
w.Range("A" & r & ":L" & r).Select
MsgBox "登録しました。"
End Sub
Private Sub ComboBox2_Change()
If ComboBox2.Text = "その他" Then
TextBox36.Enabled = True
TextBox36.BackColor = vbWindowBackground
Else
TextBox36.Text = ""
TextBox36.Enabled = False
TextBox36.BackColor = vbMenuBar
End If
End Sub
Private Sub ListBox3_Click()
TextBox54.Text = ListBox3.List(ListBox3.ListIndex, 4) '得意先コード
TextBox32.Text = ListBox3.List(ListBox3.ListIndex, 0) ' 得意先
TextBox55.Text = ListBox3.List(ListBox3.ListIndex, 5) ' 品名コード
TextBox31.Text = ListBox3.List(ListBox3.ListIndex, 1) ' 品名
TextBox30.Text = ListBox3.List(ListBox3.ListIndex, 2) ' 型式・サイズ
TextBox29.Text = ListBox3.List(ListBox3.ListIndex, 3) ' 工番
End Sub
Private Sub TextBox33_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 作業日
If IsDate(TextBox33.Text) Then
TextBox33.Text = Format(TextBox33.Text, "yyyy/mm/dd")
Else
TextBox33.Text = ""
End If
End Sub
Private Sub TextBox34_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 工数
If IsNumeric(TextBox34.Text) Then
TextBox34.Text = Format(TextBox34.Text, "#.#0")
If CCur(TextBox34.Text) * 100 Mod 25 <> 0 Then TextBox34.Text = ""
Else
TextBox34.Text = ""
End If
End Sub
' --------------------------------------------------------
' 請求書
' --------------------------------------------------------
Private Sub CommandButton4_Click() ' 請求書発行
Call create_invoice
End Sub
Private Sub TextBox40_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 発行日
If IsDate(TextBox40.Text) Then
TextBox40.Text = Format(TextBox40.Text, "yyyy/mm/dd")
Else
TextBox40.Text = ""
End If
End Sub
Private Sub TextBox41_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 対象日(開始)
If IsDate(TextBox41.Text) Then
TextBox41.Text = Format(TextBox41.Text, "yyyy/mm/dd")
Else
TextBox41.Text = ""
End If
End Sub
Private Sub TextBox46_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 対象日(終了)
If IsDate(TextBox46.Text) Then
TextBox46.Text = Format(TextBox46.Text, "yyyy/mm/dd")
Else
TextBox46.Text = ""
End If
End Sub
Private Sub TextBox44_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 支払期限
If IsDate(TextBox44.Text) Then
TextBox44.Text = Format(TextBox44.Text, "yyyy/mm/dd")
Else
TextBox44.Text = ""
End If
End Sub
Private Sub ListBox4_Click()
TextBox42.Text = ListBox4.List(ListBox4.ListIndex, 0) ' 得意先
TextBox50.Text = ListBox4.List(ListBox4.ListIndex, 1) ' 締日
TextBox51.Text = ListBox4.List(ListBox4.ListIndex, 2) ' 支払予定(経過日数)
Call GetInvoiceTerm
End Sub
' 得意先締日 OR 支払予定(経過日数) OR 締日(年月日) が変化したら請求期間の自動計算
Private Sub TextBox50_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 得意先締日
Call GetInvoiceTerm
End Sub
Private Sub TextBox51_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 支払予定(経過日数)
Call GetInvoiceTerm
End Sub
Private Sub TextBox49_Exit(ByVal Cancel As MSForms.ReturnBoolean) ' 締日(年月日)
Call GetInvoiceTerm
' フォーマット処理
If IsDate(TextBox49.Text) Then
TextBox49.Text = Format(TextBox49.Text, "yyyy/mm/dd")
Else
TextBox49.Text = ""
End If
End Sub
' ここまで
Private Sub TextBox27_Change()
' インクリメンタル検索 (品名型式マスタ)
ListBox3.Clear
Set w = Sheets("受注入力")
r = 2
Do While w.Cells(r, 1).Value <> ""
haystack = LCase(w.Cells(r, 2).Value & " " & w.Cells(r, 3).Value & " " & w.Cells(r, 4).Value & " " & w.Cells(r, 5).Value)
needle = LCase(TextBox27.Text)
If InStr(haystack, needle) > 0 Then
ListBox3.AddItem ' 得意先、品名、型式、工番
ListBox3.List(ListBox3.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox3.List(ListBox3.ListCount - 1, 1) = w.Cells(r, 3).Value
ListBox3.List(ListBox3.ListCount - 1, 2) = w.Cells(r, 4).Value
ListBox3.List(ListBox3.ListCount - 1, 3) = w.Cells(r, 5).Value
End If
r = r + 1
Loop
ListBox3.ColumnCount = 4
End Sub
Private Sub TextBox38_Change()
' インクリメンタル検索 (得意先マスタ)
ListBox4.Clear
Set w = Sheets("得意先マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
If InStr(LCase(w.Cells(r, 2).Value), LCase(TextBox38.Text)) > 0 Then
ListBox4.AddItem
ListBox4.List(ListBox4.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox4.List(ListBox4.ListCount - 1, 1) = w.Cells(r, 3).Value
ListBox4.List(ListBox4.ListCount - 1, 2) = w.Cells(r, 4).Value
End If
r = r + 1
Loop
End Sub
Sub TextBoxClear()
TextBox19.Text = "" ' 受注日
TextBox47.Text = "" ' 行
TextBox53.Text = "" ' 得意先コード
TextBox1.Text = "" ' 得意先
TextBox52.Text = "" ' 品目コード
TextBox2.Text = "" ' 品名
TextBox3.Text = "" ' 型式・サイズ
TextBox4.Text = "" ' 工番
TextBox5.Text = "" ' 数量
TextBox6.Text = "" ' 単価
TextBox7.Text = "" ' 金額
TextBox11.Text = "" ' 納期
TextBox48.Text = "" ' 注文番号
TextBox12.Text = "" ' 備考
End Sub
Sub TextBoxInitialize()
TextBox19.Text = Format(Now, "yyyy/mm/dd") ' 受注日
TextBox4.Text = CLng(Sheets("設定").Range("A2")) + 1 ' 工番
End Sub
Private Sub ToggleButton1_Click()
If ActiveSheet.Name <> "受注入力" Then Sheets("受注入力").Activate
If ToggleButton1.Value = True Then ' 更新/削除 可能状態
Call TextBoxClear
' Enabled
CommandButton5.Enabled = True ' 削除
CommandButton6.Enabled = True ' 更新
CommandButton7.Enabled = False ' クリア
CommandButton1.Enabled = False ' 登録
CommandButton8.Enabled = False ' 登録(固定)
TextBox47.Enabled = True ' 行
TextBox4.Enabled = True ' 工番
Else ' 通常状態
Call TextBoxClear
' Enabled
CommandButton5.Enabled = False ' 削除
CommandButton6.Enabled = False ' 更新
CommandButton7.Enabled = True ' クリア
CommandButton1.Enabled = True ' 登録
CommandButton8.Enabled = True ' 登録(固定)
TextBox47.Enabled = False ' 行
TextBox4.Enabled = False ' 工番
' 初期値設定
Call TextBoxInitialize
End If
End Sub
' --------------------------------------------------------
' Initialize
' --------------------------------------------------------
Private Sub UserForm_Initialize()
Set e = Application
' 受注入力 --------------------------------------------------------
' 品名型式マスタセット
Set w = Sheets("品名・型式マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
ListBox2.AddItem
ListBox2.List(ListBox2.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox2.List(ListBox2.ListCount - 1, 1) = w.Cells(r, 3).Value
ListBox2.List(ListBox2.ListCount - 1, 2) = w.Cells(r, 4).Value
ListBox2.List(ListBox2.ListCount - 1, 3) = w.Cells(r, 1).Value ' 品目コード
r = r + 1
Loop
ListBox2.ColumnCount = 2
' 得意先マスタセット
Set w = Sheets("得意先マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox1.List(ListBox1.ListCount - 1, 1) = w.Cells(r, 1).Value ' 得意先コード
r = r + 1
Loop
' 受注日
TextBox19.Text = Format(Now, "yyyy/mm/dd")
' 工番
serial = CLng(Sheets("設定").Range("A2")) + 1
TextBox4.Text = serial
' 工数入力 --------------------------------------------------------
' 登録日
TextBox37.Text = Format(Now, "yyyy/mm/dd")
' 品目型式セット
Set w = Sheets("受注入力")
r = 2
Do While w.Cells(r, 1).Value <> ""
ListBox3.AddItem ' 得意先、品名、型式・サイズ、工番
ListBox3.List(ListBox3.ListCount - 1, 0) = w.Cells(r, 3).Value
ListBox3.List(ListBox3.ListCount - 1, 1) = w.Cells(r, 5).Value
ListBox3.List(ListBox3.ListCount - 1, 2) = w.Cells(r, 6).Value
ListBox3.List(ListBox3.ListCount - 1, 3) = w.Cells(r, 7).Value
ListBox3.List(ListBox3.ListCount - 1, 4) = w.Cells(r, 2).Value ' 得意先コード
ListBox3.List(ListBox3.ListCount - 1, 5) = w.Cells(r, 4).Value ' 品目コード
r = r + 1
Loop
ListBox3.ColumnCount = 4
' 作業者マスタセット
Set w = Sheets("作業者マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
ComboBox1.AddItem w.Cells(r, 1).Value
r = r + 1
Loop
' 作業内容マスタセット
Set w = Sheets("作業内容マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
ComboBox2.AddItem w.Cells(r, 1).Value
r = r + 1
Loop
' 請求書 --------------------------------------------------------
' 発行日
TextBox40.Text = Format(Now, "yyyy/mm/dd")
' 得意先マスタセット
Set w = Sheets("得意先マスタ")
r = 2
Do While w.Cells(r, 1).Value <> ""
ListBox4.AddItem
ListBox4.List(ListBox4.ListCount - 1, 0) = w.Cells(r, 2).Value
ListBox4.List(ListBox4.ListCount - 1, 1) = w.Cells(r, 3).Value
ListBox4.List(ListBox4.ListCount - 1, 2) = w.Cells(r, 4).Value
r = r + 1
Loop
' 請求番号
serial = CLng(Sheets("設定").Range("C2")) + 1
TextBox43.Text = serial
End Sub
