'******特定履歴シート******
Sub DP_shukei()
'★★実際のシート列で要調整★★
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("特定履歴").Cells(xlLastRow, 3).End(xlUp).Row 'C列の最終行を取得
'各DP結果の合計
Range("E1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 5), Worksheets("特定履歴").Cells(LastRow, 5)))
Range("F1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 6), Worksheets("特定履歴").Cells(LastRow, 6)))
Range("G1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 7), Worksheets("特定履歴").Cells(LastRow, 7)))
Range("H1") = WorksheetFunction.CountA(Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(3, 8), Worksheets("特定履歴").Cells(LastRow, 8)))
End Sub
'******スキャンシート******
'測定状況表示ラベル新規作成(Label1 フォント太字30ポイント)
Sub CommandButton12_Click()
'測定開始ボタン
If Range("D1") = "" Then
MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
Range("D1").Select
End
End If
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Call tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("稼働時間測定").Cells(LastRow + 1, 1), "", "", 3)
CommandButton12.Enabled = False
CommandButton13.Enabled = True
Label1.BackColor = &HFFFF00
Label1.Caption = "【ピック】測定中"
With Worksheets("スキャン")
.Select
'シートの保護
.Protect
End With
'測定中断ボタン以外のボタンを操作不可(paste更新、他のボタンは要追加)
CommandButton1.Enabled = False
CommandButton2.Enabled = False
CommandButton3.Enabled = False
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton8.Enabled = False
CommandButton9.Enabled = False
CommandButton10.Enabled = False
CommandButton11.Enabled = False
CommandButton14.Enabled = False
End Sub
Sub CommandButton13_Click()
'測定中断ボタン
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
CommandButton12.Enabled = True
CommandButton13.Enabled = False
Label1.BackColor = &H8080FF
Label1.Caption = "【ピック】測定中断"
With Worksheets("スキャン")
.Select
'シートの保護解除
.Unprotect
End With
'測定中断ボタン以外のボタンを操作可能にもどす(paste更新、他のボタンは要追加)
CommandButton1.Enabled = True
CommandButton2.Enabled = True
CommandButton3.Enabled = True
CommandButton4.Enabled = True
CommandButton5.Enabled = True
CommandButton6.Enabled = True
CommandButton7.Enabled = True
CommandButton8.Enabled = True
CommandButton9.Enabled = True
CommandButton10.Enabled = True
CommandButton11.Enabled = True
CommandButton14.Enabled = True
End Sub
Sub CommandButton14_Click()
'IDクリアボタン
Range("D1") = ""
Range("D1").Select
ActiveWorkbook.Save
Range("B3").Select
End Sub
'セルC2(MAGIID)、名前表示セルは要調整
Private Sub CommandButton2_Click()
'2回目検品ボタン
If Range("D1") = "" Then
MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
Range("D1").Select
End
End If
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
UserForm2.Label1.Caption = "★★★2回目検品登録★★★" & vbCr & vbCr & "検品者MAGIID:" & Range("D1").Value & vbCr & "検品者:" & Range("D2").Value
UserForm2.Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: "
UserForm2.BackColor = RGB(0, 180, 255)
UserForm2.TextBox1.SetFocus
UserForm2.Show
End Sub
Private Sub CommandButton1_Click()
'部材検索ボタン１
'商品コードからミスミページで検索
Call misumi_search(Range("B10").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 10
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton3_Click()
'部材検索ボタン２
'商品コードからミスミページで検索
Call misumi_search(Range("B11").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 11
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton4_Click()
'部材検索ボタン３
'商品コードからミスミページで検索
Call misumi_search(Range("B12").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 12
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton5_Click()
'部材検索ボタン４
'商品コードからミスミページで検索
Call misumi_search(Range("B13").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 13
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton6_Click()
'部材検索ボタン５
'商品コードからミスミページで検索
Call misumi_search(Range("B14").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 14
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton7_Click()
'部材検索ボタン６
'商品コードからミスミページで検索
Call misumi_search(Range("B15").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 15
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton8_Click()
'部材検索ボタン７
'商品コードからミスミページで検索
Call misumi_search(Range("B16").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 16
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton9_Click()
'部材検索ボタン８
'商品コードからミスミページで検索
Call misumi_search(Range("B17").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 17
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton10_Click()
'部材検索ボタン９
'商品コードからミスミページで検索
Call misumi_search(Range("B18").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 18
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Private Sub CommandButton11_Click()
'部材検索ボタン１０
'商品コードからミスミページで検索
Call misumi_search(Range("B19").Value)
Range("AY1").Value = 1
Range("AZ1").Value = 19
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End Sub
Sub Worksheet_Change(ByVal Target As Range)
'バーコードスキャンされた時の処理
'★セルB3に入力規則を設定(整数のみ、10000～99999)
If Range("D1") = "" Then
MsgBox "MAGI IDを入力してください", vbExclamation, "★★★確認★★★"
Range("D1").Select
End
End If
'セル値が変更されたときに処理を実行
If Not Intersect(Target, Range("B3")) Is Nothing Then
Range("AY1").Value = 1
If Range("B3") <> "" Then
'スキャンしたグローバルIDで検索した商品コードをセルに表示する
Call serch_shoin_code
'部材判定
Dim n As Long
n = WorksheetFunction.CountIf(Range("B10:B19"), "<>")
If n > 0 Then
'部材のメッセージウィンドウを出す
UserForm1.Show
End
Else
'商品コードからミスミページで検索
Call misumi_search(Range("B2").Value)
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
Worksheets("DP結果入力").Select
End If
End If
End If
End Sub
Sub tokutei_rireki_input(ByVal MAGI_ID, ByVal now_time, ByVal global_ID, ByVal shohin_code, ByVal DP_kekka)
'★★実際のシート列で要調整★★
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("特定履歴").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得
Worksheets("特定履歴").Cells(LastRow + 1, 1) = MAGI_ID
Worksheets("特定履歴").Cells(LastRow + 1, 2) = now_time
Worksheets("特定履歴").Cells(LastRow + 1, 3) = global_ID
Worksheets("特定履歴").Cells(LastRow + 1, 4) = shohin_code
Select Case DP_kekka
Case 1
Worksheets("特定履歴").Cells(LastRow + 1, 5) = "DP OK"
Case 2
Worksheets("特定履歴").Cells(LastRow + 1, 6) = "一部DP OK"
Case 3
Worksheets("特定履歴").Cells(LastRow + 1, 7) = "ピック"
Case 4
Worksheets("特定履歴").Cells(LastRow + 1, 8) = "2回目 DP"
Case 5
Worksheets("特定履歴").Cells(LastRow + 1, 9) = "2回目"
Case 6
Worksheets("特定履歴").Cells(LastRow + 1, 10) = "1回目手数え"
Case Else
Worksheets("DP結果入力").Select
End Select
End Sub
Sub serch_shoin_code()
'スキャンしたグローバスIDで商品コードを検索、セルに表示する
'★pasteシートの検索セルの位置は要調整
On Error Resume Next
Dim ws As Worksheet
Dim key As String
Dim find_count As String
Dim i As Integer
'子ラベルの商品コードをセルから消す
For i = 0 To 9
Worksheets("スキャン").Cells(10 + i, 2) = ""
Next i
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
Set ws = ThisWorkbook.Worksheets("paste")
xlLastRow = ws.Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = ws.Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
key = Worksheets("スキャン").Cells(3, 2).Value
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, 1)).Find(What:=key, LookAt:=xlWhole, SearchOrder:=xlByRows)
'スキャンした商品コードと検索一致するpasteの行番号
'rng.Row
'スキャンした商品コードと検索一致するセルの個数
find_count = WorksheetFunction.CountIf(ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, 1)), key)
'商品コード(部材なら親ラベル)
Worksheets("スキャン").Cells(2, 2) = ws.Cells(rng.Row, 2).Value
'部材子ラベルの商品コード
For i = 1 To find_count - 1
Worksheets("スキャン").Cells(9 + i, 2) = ws.Cells(rng.Row + i, 2).Value
Next i
End Sub
Sub misumi_search(shohin_code As String)
Dim strURL
strURL = "https://jp.misumi-ec.com/vona2/result/?Keyword=" + shohin_code + "&isReSearch=0"
CreateObject("WScript.Shell").Run "chrome.exe -url " & strURL
End Sub
Sub Google_search(shohin_code As String)
Dim strURL
strURL = "https://www.google.co.jp/search?q=" + shohin_code + "+misumi&tbm=isch&hl=ja&lr=lang_ja&num=20&safe=high&filter=0&pws=0"
CreateObject("WScript.Shell").Run "chrome.exe -url " & strURL
End Sub
'******DB結果入力シート******
Private Sub CommandButton1_Click()
'1回目完結ボタン
'スキャン、部材ボタンが押されたかの判定
If Worksheets("スキャン").Range("AY1").Value <> 1 Then
MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End
End If
Worksheets("スキャン").Range("AY1").Value = 0
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得
'部材検索ボタンが押されたかの判定
If Worksheets("スキャン").Range("AZ1").Value > 0 Then
'★★★変更箇所★★★
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1").Value, 2), 1)
Else
'★★★変更箇所★★★
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Range("B2"), 1)
End If
'Call Worksheets("特定履歴").DP_shukei
'★★★変更箇所★★★
Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Worksheets("スキャン").Range("A1")
Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End Sub
Private Sub CommandButton2_Click()
'一部DBOKボタン
'スキャン、部材ボタンが押されたかの判定
If Worksheets("スキャン").Range("AY1").Value <> 1 Then
MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End
End If
Worksheets("スキャン").Range("AY1").Value = 0
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得
'部材検索ボタンが押されたかの判定
If Worksheets("スキャン").Range("AZ1").Value > 0 Then
'★★★変更箇所★★★
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1").Value, 2), 2)
Else
'★★★変更箇所★★★
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Worksheets("スキャン").Range("A1"), Worksheets("スキャン").Range("B3"), Worksheets("スキャン").Range("B2"), 2)
End If
'★★★変更箇所★★★
Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Worksheets("スキャン").Range("A1")
Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
'Call Worksheets("特定履歴").DP_shukei
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End Sub
Private Sub CommandButton5_Click()
'Google検索ボタン
'スキャン、部材ボタンが押されたかの判定
If Worksheets("スキャン").Range("AY1").Value <> 1 Then
MsgBox "スキャン画面に戻ります", vbExclamation, "スキャン画面での操作が必要です"
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End
End If
'商品コードからGoogleで画像検索
Call Worksheets("スキャン").Google_search(Worksheets("スキャン").Cells(Worksheets("スキャン").Range("AZ1"), 2).Value)
End Sub
Private Sub CommandButton6_Click()
'スキャン画面に戻るボタン
'★★★変更箇所★★★
'稼働時間測定の時間記録処理は削除
'スキャン、部材ボタンが押されたかの判定
If Worksheets("スキャン").Range("AY1").Value <> 1 Then
Worksheets("スキャン").Select
Worksheets("スキャン").Range("B3").Activate
End
End If
Worksheets("スキャン").Range("AY1").Value = 0
'★★★変更箇所★★★
'選択ボタンのユーザフォームを表示する
UserForm3.Show
End Sub
'******2回目検品(新規ユーザフォーム)******
'セルC2(MAGIID)、名前表示セルは要調整
Dim scan_count As Integer
Sub CommandButton1_Click()
'作業終了ボタン
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
If OptionButton1.Value = True And scan_count < 1 Then
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row 'B列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow, 1) = ""
End If
If OptionButton1.Value = True And scan_count > 0 Then
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 2).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 2).End(xlUp).Row 'B列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow + 1, 2) = Format(Now, "c")
End If
Unload UserForm2
End Sub
Sub OptionButton1_click()
'チェックボタン DPする(デフォルトでチェックON プロパティーのvalueをTrueにする)
UserForm2.BackColor = RGB(0, 180, 255)
TextBox1.SetFocus
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
Worksheets("稼働時間測定").Cells(LastRow + 1, 1) = Format(Now, "c")
'★★★変更箇所★★★
Worksheets("スキャン").Range("A1") = Format(Now, "c")
End Sub
Sub OptionButton2_click()
'チェックボタン DPしない
UserForm2.BackColor = RGB(255, 140, 0)
TextBox1.SetFocus
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("稼働時間測定").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("稼働時間測定").Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
'検品していない場合
If scan_count < 1 Then
Worksheets("稼働時間測定").Cells(LastRow, 1) = ""
'1回以上検品している場合
Else
Worksheets("稼働時間測定").Cells(LastRow, 2) = Format(Now, "c")
End If
End Sub
Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Value = "" Then
Cancel = False
TextBox1.SetFocus
Else
Cancel = True
If OptionButton1.Value = True Then
Dim ans As Variant
ans = jyufuku_ID_kensaku(TextBox1.Value)
If ans = 0 Then
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Format(Now, "yyyy/mm/dd hh:mm:ss"), TextBox1.Value, "", 4)
'★★★追加 直前登録情報をユーザフォームlabel2に表示する
Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: " & TextBox1.Value
Else
'★★★追加 直前登録情報をユーザフォームlabel2に表示する
Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: すでに登録済みです"
End If
Else
ans = jyufuku_ID_kensaku(TextBox1.Value)
If ans = 0 Then
Call Worksheets("スキャン").tokutei_rireki_input(Worksheets("スキャン").Range("D1"), Format(Now, "yyyy/mm/dd hh:mm:ss"), TextBox1.Value, "", 5)
'★★★追加 直前登録情報をユーザフォームlabel2に表示する
Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: " & TextBox1.Value
Else
'★★★追加 直前登録情報をユーザフォームlabel2に表示する
Label2.Caption = "◆◆◆直前登録情報◆◆◆" & vbCr & "グローバルID: すでに登録済みです"
End If
End If
If OptionButton1.Value = True Then
scan_count = scan_count + 1
Else
scan_count = 0
End If
TextBox1.Value = ""
End If
End Sub
Sub UserForm_Activate()
scan_count = 0
End Sub
Function jyufuku_ID_kensaku(global_ID As Variant)
'すでに登録されているグローバルIDを検索する
On Error Resume Next
Dim xlLastRow As Long 'Excel自体の最終行
Dim LastRow As Long '最終行
xlLastRow = Worksheets("特定履歴").Cells(Rows.Count, 1).Row 'Excelの最終行を取得
LastRow = Worksheets("特定履歴").Cells(xlLastRow, 1).End(xlUp).Row 'A列の最終行を取得
Dim find_row As Long
Dim id_row As Long
find_row = WorksheetFunction.Match(CLng(Date), Worksheets("特定履歴").Range("B:B"), 1)
find_id = WorksheetFunction.Match(global_ID, Worksheets("特定履歴").Range(Worksheets("特定履歴").Cells(find_row + 1, 3), Worksheets("特定履歴").Cells(LastRow, 3)), 0)
jyufuku_ID_kensaku = find_id
End Function
