| |
>これは、どのようなコード（と結果）で確認されましたか。
バーコードリーダを手に持ち２種類のコードを連続して読み込んだ場合
プリンターに印刷命令が出ていないみたいで沈黙状態です。
>違う場合は、チェンジイベントのコードを全部アップしてください。
↓処理コードです。
Private Sub Worksheet_Change(ByVal Target As Range)
Static get_hin As Variant '実パレ商品名ストック
Static t1 As Variant '実パレ伝票間タイマー
Dim i As Long
If Intersect(Target, Range("B2:B500")) Is Nothing Then
Exit Sub
Else
With Sheets("TOP")
Set gyo = .Range("I2:I400").Find(Target, lookat:=xlWhole) 'gyoはバーコード数字です
If gyo Is Nothing Then
If Target = "ハンパ" Then
GoTo hanpa_bar
Else
ActiveCell.Offset(-1, 0).Activate
Cells(Selection.Row, Selection.Column - 1) = "データ無"
End If
Else
If Range("E1") <> Date Then '日付が変わっていたらタイマーリセットする
t1 = 0
End If
If ((Timer - t1) > 2) And (Cells(gyo.Row, 10) <> get_hin) Or ((Timer - t1) > 300) Then
' 【 同じＪＡＮ、ＩＴＦでなく、2 秒経過していたら 認可 】
' 【 同じＪＡＮ、ＩＴＦでも ３００秒経過していたら認可 】
t1 = Timer
get_hin = Cells(gyo.Row, 10)
Range("L1") = gyo
Range("M1") = Cells(gyo.Row, 10)
Range("E1") = Date
Cells(Selection.Row - 1, Selection.Column - 1) = Now
Cells(Selection.Row - 1, Selection.Column + 2) = Cells(gyo.Row, 10) '品名 書込
Cells(Selection.Row - 1, Selection.Column + 3) = Date
Cells(Selection.Row - 1, Selection.Column + 4) = Cells(gyo.Row, 11)
With Sheets("伝票")
.Range("G5").Value = Cells(gyo.Row, 11) & " c/s"
.Range("A2").Value = Cells(gyo.Row, 10)
.Range("G1").Value = Worksheets("TOP").Cells(Selection.Row - 1, Selection.Column + 1)
.Range("B1").Value = Now
.Range("D1").Value = Time
.Range("A4").Value = Worksheets("TOP").Range("E2").Value
.Range("A3").Value = Worksheets("TOP").Cells(gyo.Row, 7)
If Cells(gyo.Row, 8) = 1 Then
.Range("A5").Value = Worksheets("TOP").Range("V1").Value
ElseIf Cells(gyo.Row, 8) = 2 Then
.Range("A5").Value = Worksheets("TOP").Range("V2").Value
ElseIf Cells(gyo.Row, 8) = 3 Then
.Range("A5").Value = Worksheets("TOP").Range("V3").Value
Else
.Range("A5").Value = " "
End If
End With
Call total
For i = 2 To 20 Step 1
If Cells(i, 12) = Cells(gyo.Row, 10) Then
Cells(Selection.Row - 1, Selection.Column + 1) = Cells(i, 14).Value
Worksheets("伝票").Range("G1").Value = Cells(i, 14).Value
Else
End If
Next
With Worksheets("伝票").OLEObjects("BarCodeCtrl1")
.Width = .Width - 5
.Width = .Width + 5
End With
With Worksheets("伝票").OLEObjects("BarCodeCtrl2")
.Width = .Width - 5
.Width = .Width + 5
End With
Debug.Print Target.Address, "印刷"
Debug.Print
Worksheets("伝票").PrintOut
Else
ActiveCell.Offset(-1, 0).Activate
Cells(Selection.Row, Selection.Column - 1) = "300秒タイマ"
End If
End If
End With
End If
hanpa_bar:
End Sub
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Sub Workbook_Open()
UserForm1.Show vbModeless
UserForm1.ListBox1.RowSource = "TOP!l2:r21"
UserForm1.ListBox1.ColumnCount = 7
UserForm1.ListBox1.ColumnWidths = "300,99,77,55,99,99,33"
UserForm1.Label1.Caption = Date & " " & WeekdayName(Weekday(Date))
AppActivate Excel.Application
Sheets("TOP").Select
'終了時、下記の無効データなら行ずらし
If Cells(Rows.count, 1).End(xlUp).Offset(0, 0).Value = "300秒タイマ" Or _
Cells(Rows.count, 1).End(xlUp).Offset(0, 0).Value = "データ無" Then
Cells(Rows.count, 2).End(xlUp).Offset(0, 0).Select
Else
Cells(Rows.count, 2).End(xlUp).Offset(1, 0).Select
End If
'Dim myStr As String
'
'mdToday = Range("E2")
'Range("v6") = Format(mdToday, "mm")
'Range("v7") = Format(mdToday, "dd")
'j = Range("v6")
'i = Range("v7")
'Range("v8") = Cells(j, 20) & Cells(i, 20) & " →" & Cells(i, 19)
'Range("v9").Value = DateAdd("yyyy", 1, Range("E2"))
'myStr = DateAdd("d", -1, Range("v9").Value) & "FN"
'Range("v9").Value = myStr
'myStr = Replace(myStr, "20", "")
'Range("v10").Value = myStr
'Range("v11").Value = Replace(myStr, "/", "")
'
'myStr = DateAdd("yyyy", 2, Range("E2"))
'myStr = DateAdd("d", -1, myStr) & "FN"
'myStr = Replace(myStr, "20", "")
'Range("v12").Value = Replace(myStr, "/", "")
End Sub
Private Sub s4()
Dim SoundFile As String, rc As Long
SoundFile = "C:\Windows\Media\end.wav"
If Dir(SoundFile) = "" Then
MsgBox SoundFile & vbCrLf & "がない。ψ(｀∇´)ψ ", vbExclamation
Exit Sub
End If
rc = mciSendString("Play " & SoundFile, "", 0, 0)
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ans As Integer
Dim folder_name As String, 年 As Integer, 月 As String, 日 As String, 秒 As String
Dim 時 As String, 分 As String, file_name As String
ThisWorkbook.Save
folder_name = "C:\data"
年 = Mid(Year(Now()), 3, 2)
月 = Month(Now())
日 = Day(Now())
時 = Hour(Now())
分 = Minute(Now())
秒 = Second(Now())
file_name = 年 & "年_" & 月 & "月" & 日 & "日" & 時 & "時" & 分 & "分" & 秒 & "秒 実パレット.xls"
ActiveWorkbook.SaveAs Filename:=folder_name & "\" & file_name
End Sub
'--------------------------------------------------------------------
'半端ふぉーむshow
'--------------------------------------------------------------------
Private Sub CommandButton2_Click()
If Me.ListBox1.Text = "" Then
MsgBox "製品を選んでちょ ψ(｀∇´)ψ "
Else
UserForm2.Label1.Caption = Me.ListBox1.Text
UserForm2.Show
End If
End Sub
|
|
うどん
- 13/10/28(月) 10:46 -
