• ベストアンサー

VBAのDoEventsが上手く動きません

お世話になります。 ExcelのVBAで印刷処理をしているのですが、印刷枚数が多いのでDoEventsイベントを入れ、印刷中断処理を行いたいのですが、上手くできません。 印刷中ダイアログが表示されるのが原因なのでしょうか？それともコードの書き方が悪いのでしょうか？よろしくお願いします。 コードは以下のとおりです。 ************************************************ Public Can_flg As Boolean ************************************************ Private Sub CommandButton1_Click() 　　Can_flg = True End Sub ************************************************ Private Sub UserForm_Activate() 　　Dim ms As String 　　Dim j As integer 　　Can_flg = False 　　For j = 1 To 31 　　　DoEvents 　　　If Can_flg = True Then 　　　　　ms = MsgBox("印刷を中止します。", vbOKCancel) 　　　　　　　If ms = vbOK Then 　　　　　　　　Exit For 　　　　　　　Else 　　　　　　　　Can_flg = False 　　　　　　　End If 　　　End If 　　　Me.Label1.Caption = "印刷中です… (" & j & "/" & i & "ページ)" 　　　Sheets("テスト").PrintOut 　　Next j 　　Unload Me End Sub

  • bo281
  • お礼率19% (12/63)

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 >　　　Sheets("テスト").PrintOut プリンタードライバに命令を送った後では、もう中止命令は利きません。 印刷中は、また、CommandButton も生きていないように思います。 その割り込みのタイミングの取り方ではありませんか？ １枚目は仕方がありませんが、その後で割り込みが入れられるようなスタイルはどうでしょうか？Wait を入れた分だけ遅くはなりますが、割り込みは入れられるようになるかと思います。 本来は、Esc で、割り込みを入れる方法もあると思いますが、CommnadButtonを入れているので、あえて、こうしました。 Me.Label1.Caption = "印刷中です… (" & j & "/" & i & "ページ)" 　　　Sheets("テスト").PrintOut 　　　Application.Wait Now() + TimeValue("00:00:03") 　　　DoEvents

その他の回答 (1)

  • Bickyon
  • ベストアンサー率41% (42/101)
回答No.1

同じコードを貼り付けて試してみましたが、うまく動きましたよ。 ただ、すぐに終わってしまうのでFor文のToの値は32767に変更して実行しました。 Sheets("テスト").PrintOutをコメント化し、Can_flg = Trueの行にDebugポイントを設定して動作のトレースを行ってみてはどうですか？

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • Excel VBA で処理中断(DoEvents)ができなくて困ってい

    Excel VBA で処理中断(DoEvents)ができなくて困っています。 まず、CommandButton1ボタンでSampleをコールし、Sample処理の中でループを廻し、途中でCommand1ボタンをクリックして、処理中断（DoEventsによって）をいれたいと思っています。 しかし、Command1ボタンをクリックしても処理中断がきかないのです。 グローバル変数ｆStopにはCommand1ボタンをクリックしたときにTrueが入っていることは、MsgBoxで確認していますが、Sample処理の方に値がつたわっていないようで、ループが最後まで止まりません。 コードが悪いのでしょうか、それとも、DoEventsの使い方が悪いのでしょうか。 もし、DoEventsが使えないのであれば、代替手段はありますでしょうか。 （長時間の印刷中の処理中断に応用したいと思っています） 環境はExcel 2002 SP3 , VB 6.0 , Windows XPです。 なお、DoEventsのコードは以下のURLを参考にして作成しました。 http://officetanaka.net/excel/vba/function/DoEvents.htm コードは以下のとおりです。 '********* Dim fStop As Boolean 'グローバル変数を宣言 '********* Sub Sample() Dim i As Long fStop = False For i = 1 To 1000000 DoEvents If fStop = True Then MsgBox "処理が中断されました" Exit For End If Next i End Sub '******** Private Sub CommandButton1_Click() Call Sample End Sub '******** Private Sub Command1_Click() fStop = True MsgBox "fStop=" & fStop End Sub

  • VBA DoEvents関数の働きと使い方を知りたい

    下記のような UserForm上の Module コードを書いてももらったのですが、DoEvents の働きが分からないのです。どなたか分かりやすく説明していただけませんでしょうか？ Private i As Integer Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Me.TextBox1.Value = Me.Label1.Caption Then Me.Label2.Caption = "正解です" Else Me.Label2.Caption = "不正解です" End If DoEvents If i < 20 Then i = i + 1 Label_Up Me.TextBox1.Value = "" Cancel = True Else MsgBox "終了です" End If End Sub Private Sub UserForm_Initialize() i = 1 Label_Up End Sub Private Sub Label_Up() Me.Label1.Caption = Sheets("Sheet1").Range("A1:A20").Cells(i).Value DoEvents End Sub

  • 素数を求めるマクロを

    走らすと暴走したようになり、素数＝１５１で止まります。 どこが悪いのでしょうか。正常に終わるようにしたいです。 ====================== Sub 素数を求める() 　　Dim i As Long 　　Dim j As Long 　　Dim m As Long 　　Dim p As Long 　　Dim flg As Boolean 　　i = 1 　　j = 1 　　p = 2 　　Do 　　　　flg = False 　　　　For m = 2 To Int(Sqr(p)) 　　　　　　If p Mod m = 0 Then 　　　　　　　　flg = True 　　　　　　　　Exit For 　　　　　　End If 　　　　Next 　　　　If flg = False Then 　　　　　　Cells(i, j) = p 　　　　　　i = i + 1 　　　　　　If i > Rows.Count Then 　　　　　　　　i = 1 　　　　　　　　j = j + 1 　　　　　　End If 　　　　End If 　　　　p = p + 1 　　Loop End Sub ======================

  • VBAでWorkbook_BeforeSaveイベントで質問

    Workbook_BeforeSaveイベントである条件に達していればExcelファイルを終了したくないのですがどうすればよいでしょうか？ WindowsXP ProSP2、Excel2000 コード例） Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) dim flg as boolean if flg=true then exit sub end if End Sub

  • エクセルVBAのイベントで質問です。

    ダブルクリックイベントで、G12:G31の範囲の文字列をB10:B27の範囲(最下行)に入れていくものを使っていますが、新たにH12:H31にある文字列もダブルクリックするとC10:C27の範囲(最下行)に入れていけるようにしたいと思います。 どのようにすればいいでしょうか。 ご存知の方いらっしゃればお教えいただけると助かります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, _ Cancel As Boolean) Dim i As Long Dim flg As Boolean If Intersect(Target, Range("G12:G31")) Is Nothing Then Exit Sub If IsEmpty(Target.Value) Then Exit Sub With Worksheets("シートＡ") For i = 10 To 27 If .Range("B" & i).Value = "" Then .Range("B" & i).Value = Target.Value flg = True Exit For End If Next i If flg = False Then MsgBox .Name & " がいっぱいです。" End If End With Cancel = True End Sub

  • アクセスvba if文の記述方法

    検索フォームを作成しました。 入力項目は「氏名」「カナ」で入力チェックをおこなっております。 （未入力）メッセージを表示「未入力です」 （入力有）結果一覧のフォームを表示 未入力チェックは正常に処理されておりメッセージが表示されます。 項目に値を入力した場合フォームが起動しません。 if文から外した場合は正常に実行されます。 この条件の場合if文でどのように記述したらよいのでしょうか。 宜しくお願いします。 Private Sub 検索_Click() Dim mct As Control Dim flg As Boolean flg = False For Each mct In Me.Controls 　If mct.ControlType = acTextBox Then 　　If mct.Tag = "Check" Then 　　　If Not IsNull(mct) Then 　　　　flg = True 　　　　Exit Sub 　　　End If 　　End If 　End If Next mct If flg = True Then 　Dim str As String 　str = "[氏名] Like ""*" & Me!氏名 & "*"" And [カナ] Like ""*" & Me!カナ & "*""" 　DoCmd.OpenForm "結果一覧", , , str Else 　MsgBox ("未入力です") End If End Sub

  • vb コンボボックスのイベントについて

    こんばんわ。 コンボボックスで、 指定の値をマウス操作でクリックしたときと、 キーボードの上下で、移動後returnを押したときだけ、 MsgBox "処理実行" を実行したいです。 keystateを使ってみたのですが、前の情報が残っているのかうまくいきません。keystateの情報をクリアさせるか、シンプルに上記を動作させる何かよい方法はありますでしょうか。 Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Dim flg1 As Boolean Private Sub form_load() Combo1.AddItem (11) Combo1.AddItem (22) Combo1.AddItem (33) Combo1.AddItem (44) End Sub Private Sub Combo1_Keyup(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then 'return flg1 = True Call Combo1_click End If End Sub Private Sub Combo1_click() If (GetKeyState(&H26) <> 0) Or (GetKeyState(&H28) <> 0) Then ' ↑↓ If flg1 = False Then Exit Sub End If End If MsgBox "処理実行" flg1 = False End Sub

  • VBAを使ったストップウォッチを時/分/秒で・・・

    エクセルでVBAを使って、ストップウォッチの様な形で時間を表示しながら計測したおのですが、以下のマクロだと少数点が表示されており、且つ、60秒に達したときに分に切り替わらない為、分に換算しなければなりません。 Private blnStop As Boolean Private blnStart As Boolean Sub StopWatch() 　　Dim dblTimer As Double 　　If blnStart = True Then 　　　　blnStop = True 　　　　Exit Sub 　　End If 　　blnStart = True 　　blnStop = False 　　dblTimer = Timer 　　Do Until blnStop = True 　　　　Cells(1, 1) = Int((Timer - dblTimer) * 100) / 100 　　　　DoEvents 　　Loop 　　blnStart = False 　　blnStop = False End Sub この様に、常に時間を特定のセルに表示させながら計測する様な形にしたいのですが、どうすれば「１時間20分50秒」の様な表示にできるでしょうか。 どなたかよろしくお願いいたします。

  • VBAでスロットを作る

    　VBAでゲームを作ろうとしています。まず、手始めに簡単なスロットを作っています。スロットを回転させて止めるまではできたのですがメッセージを出す段階でメッセージが2回、0とiの値が出ます。次のコードなのですが、なぜできないのか、どうすればできるようになるのか教えてください。よろしくお願いします。 Sub SlotLoop_1() Dim i As Long Static Flg As Boolean Flg = Not Flg 'ボタンを使えるようにする With [a1] 'Ａ１を選ぶ Do If Flg = False Then Exit Do i = (i + 1) Mod 10 '（i+1）を10で割った余り。 .Value = i DoEvents Loop End With MsgBox i 'ここが問題 End Sub

  • vba boolean変数を開放する方法

    エクセルのセルに「○○○○○○○○○○××××××××××」と入っているものをランダムに並べ代えるマクロを探してみました。 Sub macro2() Dim i, m As Integer Dim b, c As String Dim flg(1 To 20) As Boolean b = Cells(1, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(1, 2).Value = c End Sub これはうまく動くのですが、10行分やろうとして、以下のように変更すると暴走（終わらない）します。 Sub macro2() Dim i, m, n As Integer Dim b, c As String Dim flg(1 To 20) As Boolean For n = 1 To 10 b = Cells(n, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(n, 2).Value = c next n End Sub 一行目が終わってもboolean変数の値がそのまま残っているのが原因らしいのですが開放する方法がわかりません。 取りあえずもう一つマクロを追加してやりたいことはできたのですが、 Sub macro1() Dim n As Integer For n = 1 To 10 Call macro2(n) Next n End Sub Sub macro2(n As Variant) 以下略 なんかスッキリしません。 boolean変数を開放し、マクロひとつですます方法を教えて頂きたくお願いします。 flg(m) = Falseを挿入してもダメでした。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する