投稿日	： 2007/04/23(Mon) 20:28
投稿者	： カズ
Ｅメール	：
ＵＲＬ	：
タイトル	： 印刷の効率化

'検査結果の表示
    xlApp.ActiveWindow.LargeScroll Down:=-1
    xlApp.ActiveWindow.SmallScroll Down:=52
    xlSheet.Range("J63:L65").Select
    '
    xlSheet.Range("A63").Select

    '一覧表コピー
    xlSheet.Range("AZ1:FN1").Select
    xlSheet.Range("AZ1:FN1").Copy


    '一覧表へ転送
    Set xlBook2 = xlApp.Workbooks.Open(pstrPcConf2File)
    Set xlSheet2 = xlBook2.Worksheets(1)
    xlSheet2.Range("A65536").Select 'セル末端へ移動
    xlSheet2.Range("A65536").End(xlUp).Select
    intWkRow = xlApp.ActiveCell.Row + 1
    strRangeWk = "A" & intWkRow
    xlSheet2.Range(strRangeWk).PasteSpecial Paste:=xlPasteValues,
Operation:=xlPasteSpecialOperationNone, _
                                                SkipBlanks:=False,
Transpose:=False
    ''Excelファイル保存
    xlBook.SaveAs
    '
    '検査結果一部消去
    xlSheet2.Range("AZ1:FN1").Clear
    xlApp.ActiveWindow.LargeScroll ToRight:=-11
    xlBook2.Save
    xlBook2.Close
    Set xlSheet2 = Nothing
    Set xlBook2 = Nothing
    '
    'ラベル印刷422(バーコード印刷 ベルトロットNo入力)
    xlApp.CutCopyMode = False
    xlSheet.Range("F62").Select
    xlSheet.Range("F62").Copy
    Set xlBook2 = xlApp.Workbooks.Open(pstr422LabelTmplt)
    Set xlSheet2 = xlBook2.Worksheets(1)
    xlSheet2.Range("G8").Select
    xlSheet2.Range("G8").PasteSpecial Paste:=xlPasteValues,
Operation:=xlPasteSpecialOperationNone, _
                                        SkipBlanks:=False,
Transpose:=False
    xlSheet2.PrintOut
    xlBook2.Close
    Set xlSheet2 = Nothing
    Set xlBook2 = Nothing
    'CSV用データ
    xlSheet.Range("A1:L65").Select
    xlSheet.Range("A1:L65").Copy
    Set xlBook2 = xlApp.Workbooks.Add
    Set xlSheet2 = xlBook2.Worksheets(1)
    xlSheet2.Paste
    strLotNo = xlSheet2.Range("E3").Value
    xlBook2.SaveAs FileName:=pstr422CsvDir & "\" & strLotNo & ".csv", _
                    FileFormat:=xlCSV, Password:="", WriteResPassword:="",
_
                    ReadOnlyRecommended:=False, CreateBackup:=False

    'データファイル閉じる
    'CSV閉じる
    'xlApp.ActiveWindow.Close

    Set xlSheet2 = Nothing
    Set xlBook2 = Nothing

    '移動表の外観(後工程),梱包、出荷,合否判定を未検査→済み設定
    vrtYmdData = Array(txtOutRndYmdFnl.Text, txtPackYmd.Text & "/" &
txtShipYmd.Text, _
                       txtGouhiYmd.Text)
    vrtIdoItem = Array("後工程", "梱包" & "/" & "出荷", "合否")
    For i = 0 To 2
        If i <> 1 Then
            '外観(後工程),合否判定
            For j = 1 To LstIdo1(0).ListCount
                If InStr(1, LstIdo1(0).List(j - 1), vrtIdoItem(i)) <> 0
Then
                    If vrtYmdData(i) <> "" Then
                        LstIdo1(1).List(j - 1) = "済み"
                    End If
                    Exit For
                End If
            Next
        Else
            '梱包、出荷
            vrtYmdWkData = Split(vrtYmdData(1), "/")
            vrtKindWkData = Split(vrtIdoItem(1), "/")
            For j = 1 To LstIdo1(0).ListCount
                For k = 0 To 1
                    If InStr(1, LstIdo1(0).List(j - 1), vrtKindWkData(k))
<> 0 Then
                        If vrtYmdWkData(k) <> "" Then
                            LstIdo1(1).List(j - 1) = "済み"
                        End If
                    End If
                Next
            Next
        End If
    Next

    'データファイル閉じる
    strLotNoWk = xlSheet.Range("E3").Value & ".xls"
    Clipboard.Clear
    xlApp.Quit
    'ファイルの消去
    '************************************************
    'プリント処理待ちWait 追加　180秒　2007.01.25 RH
    Dim varTIME_NOW As Variant
    varTIME_NOW = Now
    While DateDiff("s", varTIME_NOW, Now) < 180
    DoEvents
    Wend
    '************************************************
    Kill pstr422FileList & "\" & strLotNoWk    'ネットワーク先のファイル
    '*************************************************************
    '消去ファイル名記録
    Dim Fsys As FileSystemObject
    Dim TStream As TextStream
    Set Fsys = New FileSystemObject
    Set TStream = Fsys.OpenTextFile("C:\temp\ERRLOG.TXT", ForAppending,
False, TristateFalse)
    With TStream
        .WriteLine (strLotNoWk)
        .Close
    End With
    Set TStream = Nothing
    Set Fsys = Nothing
    '**************************************************************
'****************************************
'Object Erase Order Change RH 2007.01.23
'    Set xlApp = Nothing
'    Set xlBook = Nothing
'    Set xlSheet = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
'Change End
'****************************************


    '画面CLOSE
    'Me.Hide
    Unload Me
    Set formFinish422 = Nothing
    Exit Sub

Err_LBL:
    MsgBox "エラーが発生しました", vbOKOnly, "仕上げ検査入力作業表表示"
End_LBL:
    Clipboard.Clear
    xlApp.Quit
'****************************************
'Object Erase Order Change RH 2007.01.23
'    Set xlApp = Nothing
'    Set xlBook = Nothing
'    Set xlSheet = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
'Change End
'****************************************
End Sub

  
上記のコードはエクセルのデータを印刷し、3分経過後にそのデータを消去するプログラムの後半部分です。これだと３分経過しないと次の印刷がおこなえません。これを解消するためにコードを少し修正したいのです。まず印刷したいエクセルのデータを別のフォルダにコピーして印刷したいのです。３分立ってデータを消去するのは同じですが、フォルダ内で消去します。一番の違いはデータの消去を待たずに順次、印刷をおこなう処理にしたいわけです。効率化のために。ようするにフォルダ内にコピーされてきたデータをどんどん印刷したいのです。どのように修正をおこなえばよいでしょうか？

★ - 印刷の効率化 - カズ 04/23-20:28No.9003
• Re: 印刷の効率化 - neptune 04/23-21:52 No.9005
  • Re^2: 印刷の効率化 - カズ 04/23-22:37 No.9006