Excel VBA質問箱 IV

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

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


1353 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【74923】印刷がキャンセルされているようです(な...
質問  うどん  - 13/10/26(土) 18:57 -

引用なし
パスワード
   VBA歴1年です。下記のイベント入力で検索後、印刷を行っていましたが
1秒間隔でイベント入力があった場合、印刷命令がキャンセルされて
いるみたいでセルのログには残ってますが印刷が無効になります。
なにか対策法などあるのでしょうか?


Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("B2:B10000")) Is Nothing Then
    Exit Sub

  Else
  Worksheets("伝票").PrintOut
  
  End If
End Sub

【74924】Re:印刷がキャンセルされているようです...
発言  γ  - 13/10/26(土) 19:40 -

引用なし
パスワード
   こんにちは。
>1秒間隔でイベント入力があった
具体的にどのような方法で実行されているのでしょうか。
>セルのログ
とは何でしょうか。

【74925】Re:印刷がキャンセルされているようです...
回答  うどん  - 13/10/27(日) 8:33 -

引用なし
パスワード
   >具体的にどのような方法で実行されているのでしょうか。
バーコードリーダで自動読み取りをしています。
USB入力なのでキーボードと同じです。

>>セルのログとは何でしょうか。
B列にB2、B3、B4と入力された後、改行されます。

【74926】Re:印刷がキャンセルされているようです...
回答    - 13/10/27(日) 14:01 -

引用なし
パスワード
   こんにちは。

ご説明を拝見して、不思議だなあ、と思いました。
われわれ人間にとって1秒はあっという間ですが、CPUにとっては
とてもとても長い時間です。CPUは1秒間に10億回から計算ができます。
だから1秒おきのデータ入力が、速すぎてCPUがアップアップするとは
考えにくいです。
本当に1秒間隔の入力が原因ですか? ほかに原因はありませんか?

あえて考えれば、プリンタかなあ? と思います。
プリンタは、実際に紙を捕まえて動かして 紙にトナーを載せて定着して
という時間のかかる作業を担当しますので、もしかしたら、
印刷待ちリストが満杯になってあふれた分は捨てられたのかも知れない
と考えます。


まずは、パソコンの問題なのか、プリンタの問題なのか、切り分けましょう。
イベントのコードをちゃんと通っているか確認してみてはどうでしょう。

>Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address,Target.Value
>  If Intersect(Target, Range("B2:B10000")) Is Nothing Then
Debug.Print
>    Exit Sub
>
>  Else
Debug.Print Target.Address,"印刷"
Debug.Print
>  Worksheets("伝票").PrintOut
>  
>  End If
>End Sub

【74929】Re:印刷がキャンセルされているようです...
発言  うどん  - 13/10/27(日) 19:37 -

引用なし
パスワード
   Debug.Print したら10000件の検索に1秒ほど時間がかかっており
次のイベントが入力された時点で「検索処理」が中断されている様子です。

「検索処理が終わるまでイベント入力待て」というような無理な構文
ないでしょうか?(;;)

【74930】Re:印刷がキャンセルされているようです...
発言  γ  - 13/10/27(日) 21:06 -

引用なし
パスワード
   ▼うどん さん:
コメントありがとうございました。

>10000件の検索に1秒ほど時間がかかっており
ちなみに、これはどんなコードで実行しているのでしょう。
もう少し高速化できないですか。

それとセルに入力のたびに印刷が不可避なんですか?
入力セルと値を別ファイルにログ出力し、
何回かに一度印刷するとかでは用を成さないのですか?

【74931】Re:印刷がキャンセルされているようです...
発言    - 13/10/28(月) 6:59 -

引用なし
パスワード
   こんにちは

>Debug.Print したら10000件の検索に1秒ほど時間がかかっており
これは、どのようなコード(と結果)で確認されましたか。

10000件の検索とは、もしかしてコレのことでしょうか
>  If Intersect(Target, Range("B2:B10000")) Is Nothing Then
違う場合は、チェンジイベントのコードを全部アップしてください。
  〃   検索以外にも秘密のコードがあるのではないか
      そこに問題があるのではないかと危ぶんでしまいます。


>次のイベントが入力された時点で「検索処理」が中断されている様子です。
これは、どのようなコード(と結果)で確認されましたか。

【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

【74933】Re:印刷がキャンセルされているようです...
お礼  うどん  - 13/10/28(月) 10:53 -

引用なし
パスワード
   If ((Timer - t1) > 2) And (Cells(gyo.Row, 10) <>
get_hin) Or ((Timer - t1) > 300) Then
 ' 【 同じJAN、ITFでなく、2 秒経過していたら 認可 】

すいません。自分で今、気づいたんですけど。。。
自分で2秒以上じゃないと認可しないようにと
数ヶ月前に組んだのを 今気が付きました!。。
たぶんこれで弾いているんだと思われます。
すいませんでした。m(__)m

【74938】Re:印刷がキャンセルされているようです...
発言    - 13/10/28(月) 20:42 -

引用なし
パスワード
   こんにちは。
これで解決すると良いですね。


ところで、ご質問から すこしずれますが、
「イベントのコードの処理が済まないうちに次のイベントが起きたらどうなるか」
これまで考えたこともなかったので、面白いと思い、試してみました。

結果は「コードが終了するまで次のイベントを待たせる」です。
末尾記載のコードに対し、手入力でアクティブセルに1を10回、
1秒おきに入力しました。


標準モジュールに
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

シートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
  Debug.Print "Change", Timer
  Sleep 1500
  Debug.Print "Sleep1500", Timer
  Debug.Print
End Sub

【74940】Re:印刷がキャンセルされているようです...
発言  うどん  - 13/10/29(火) 3:56 -

引用なし
パスワード
   >これで解決すると良いですね。

解決しませんでした;

If ((Timer - t1) > 2) And (Cells(gyo.Row, 10) <>
  get_hin) Or ((Timer - t1) > 300) Then

数値2をより小さい数字にしても動作は同じでした。

>Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
>Sleep 1500

あ、以前
Application.Wait [NOW()+"0:00:05.5"] '5秒間沈黙
とかやって駄目でした。うえのAPIと同じことでしょうか?

いろいろ調べてて思ったんですけどVBAってひとつのことしかできなくて
2つの作業が同時にできないと書いてあったんですけど
新しいイベント入力があったら、今行っている印刷作業を「投げ出して」
新しい作業を行うってことは、ないのでしょうか?
自分の妄想ですが。。。(なぞは深まるばかり)

【74946】Re:印刷がキャンセルされているようです...
回答    - 13/10/29(火) 21:10 -

引用なし
パスワード
   こんにちは。

コードを動かしてみました。

まず最低限の環境を作って、入力すると1枚印刷されるのを確認。
次に、1秒おきに何件か入力して、印刷されないのを確認。
ここまで うどんさんの説明どおりです。

それから、うどんさんが怪しいと仰ったif文を「if true then」に
書き換えて1秒おきに何件か入力。
印刷されました。これで原因はあのif文に確定です。


> 新しいイベント入力があったら、今行っている印刷作業を「投げ出して」
> 新しい作業を行うってことは、ないのでしょうか?
「次のイベントを待たせてでも自分のコードを全うする」エクセル君の姿を
わたしはつい先日見たばかりです。debug.printは投げ出さなかった。
PrintOutに限り投げ出すと考える理由がありますか。

【74954】Re:印刷がキャンセルされているようです...
お礼  うどん  - 13/10/31(木) 5:04 -

引用なし
パスワード
   >それから、うどんさんが怪しいと仰ったif文を「if true then」に

やってみました。見事、順次印刷されました。条件判定も改善しました。
ありがとうございます。

当方食品メーカです。
お礼に当社の商品をお送り致しますので
宜しければ下記までメール下さいませ。
2013_5@pc.117.cx

【74955】Re:印刷がキャンセルされているようです...
発言    - 13/10/31(木) 5:13 -

引用なし
パスワード
   解決したようで、良かったようです。

このような掲示板は順送りです。
お礼はわたしにではなく、今後の質問者さんに、
商品ではなく、回答で、なさってください。

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