none
ネットワークプリンターの切替でリソース不足発生 RRS feed

  • 質問

  • 助けてください。非常に困っています。

    VBAでセル値が変化した時にプリンターAまたはプリンターBに切替を行っていますが、

    そうしても110枚程度印刷するとリソース不足が発生し、デバックを要求されます。

    プリンターAのみだと1000枚でも問題無く、プリンターBだけでも同じく1000枚クリアーしています。

    切替を1回でも行うとやはり110枚程度でリソース不足が発生します。

    50枚でファイルを保存しないで強制終了するコード書いて、直ぐに再度開くを繰り返すと、1000まいまでクリアー出来ました。

    ブックの再起動だけではクリアー出来ません。Execl本体の再起動が必要なようです。

    コードでリソース解放か、Execlの再起動のコード(プロシージャー)をご教示ください。

    Private Sub Auto_Open()
       ActiveWorkbook.Worksheets("form").Activate  'シートformをアクティブにする
       Application.OnTime EarliestTime:=TimeValue("4:59:00"), Procedure:="Excel_Quit"
        一定時間周期でプロシージャー実行
    End Sub
    Private Sub 一定時間周期でプロシージャー実行()
        myReserveTime = Now + TimeValue("00:00:5")
        Application.OnTime EarliestTime:=myReserveTime, Procedure:="一定時間周期でプロシージャー実行"
            チェンジプリンター
       DoEvents
    End Sub

    Private Sub チェンジプリンター() '印刷切り替え処理
        If Worksheets("DeviceRead-Write").Cells(6, 13).Value = 1 Then  'I6 が1ならEPSON_Aに印刷する(D10000上位2ビットが1)
            プリンターA出力
        ElseIf Worksheets("DeviceRead-Write").Cells(6, 13).Value = 2 Then  'I6 が1ならEPSON_Bに印刷する(D10000上位2ビットが2)
            プリンターB出力
            Else
            DoEvents
        End If
    Exit Sub
    End Sub
    Private Sub プリンターA出力():    'プリンターAに印刷

            Application.ActivePrinter = "EPSON_A on Ne02:"      'プリンターAを指定
            Worksheets("form").PrintOut                         'シートFormの印刷
            Worksheets("DeviceRead-Write").Range("P3").Value = Worksheets("DeviceRead-Write").Range("P3") + 1

        If Worksheets("form").Cells(8, 18).Value = 50 Then '出力枚数50枚でExecl再起動
            Excel_Quit
            Else
            DoEvents
        End If

    Exit Sub
    End Sub
    Private Sub プリンターB出力():    'プリンターBに印刷

            Application.ActivePrinter = "EPSON_B on Ne01:"       'プリンターBを指定
            Worksheets("form").PrintOut                         'シートFormの印刷
            Worksheets("DeviceRead-Write").Range("P3").Value = Worksheets("DeviceRead-Write").Range("P3") + 1

        If Worksheets("form").Cells(8, 18).Value = 50 Then '出力枚数50枚でExecl再起動
            Excel_Quit
            Else
        End If

    Exit Sub
    End Sub

    '全ての Book を保存しないで閉じる
    '最後に Excel も終了する
    Private Sub Excel_Quit()
        Dim w As Workbook
        For Each w In Workbooks    '全ての Book を保存したことにする (保存はしない)
            w.Saved = True
        Next
        Application.Quit            'Excel を終了する
        ThisWorkbook.Close False    'Book を閉じる
    End Sub

    現在、コードが不明なため以下のバッチファイルを作成して

    再起動を繰り返して運用しています。

    ExeclOpen.bat

    Echo Off

    Echo Execl 自動オープンしました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 1回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 2回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 3回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 4回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 5回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 6回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 7回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 8回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 9回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 10回目 Execl 再起動しました。
    START /WAIT D:\Desktop\Test.xlsm

    Echo 規定再起動を終了しました。
    Echo コンピュータを再起動してください。

    Pause

    2014年8月12日 3:35