Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7387 / 76732 ←次へ | 前へ→

【74932】Re:印刷がキャンセルされているようです(なぞ
質問  うどん  - 13/10/28(月) 10:46 -

引用なし
パスワード
   >これは、どのようなコード(と結果)で確認されましたか。

バーコードリーダを手に持ち2種類のコードを連続して読み込んだ場合
プリンターに印刷命令が出ていないみたいで沈黙状態です。

>違う場合は、チェンジイベントのコードを全部アップしてください。

↓処理コードです。

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

              ' 【 同じJAN、ITFでなく、2 秒経過していたら 認可 】
              ' 【 同じJAN、ITFでも 300秒経過していたら認可 】

              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
326 hits

【74923】印刷がキャンセルされているようです(なぞ うどん 13/10/26(土) 18:57 質問
【74924】Re:印刷がキャンセルされているようです(... γ 13/10/26(土) 19:40 発言
【74925】Re:印刷がキャンセルされているようです(... うどん 13/10/27(日) 8:33 回答
【74926】Re:印刷がキャンセルされているようです(... 13/10/27(日) 14:01 回答
【74929】Re:印刷がキャンセルされているようです(... うどん 13/10/27(日) 19:37 発言
【74930】Re:印刷がキャンセルされているようです(... γ 13/10/27(日) 21:06 発言
【74931】Re:印刷がキャンセルされているようです(... 13/10/28(月) 6:59 発言
【74932】Re:印刷がキャンセルされているようです(... うどん 13/10/28(月) 10:46 質問
【74933】Re:印刷がキャンセルされているようです(... うどん 13/10/28(月) 10:53 お礼
【74938】Re:印刷がキャンセルされているようです(... 13/10/28(月) 20:42 発言
【74940】Re:印刷がキャンセルされているようです(... うどん 13/10/29(火) 3:56 発言
【74946】Re:印刷がキャンセルされているようです(... 13/10/29(火) 21:10 回答
【74954】Re:印刷がキャンセルされているようです(... うどん 13/10/31(木) 5:04 お礼
【74955】Re:印刷がキャンセルされているようです(... 13/10/31(木) 5:13 発言

7387 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free