タイトル | : Excelが解放されない |
記事No | : 14807 |
投稿日 | : 2010/07/08(Thu) 18:27 |
投稿者 | : rgnoo |
いつもお世話になっております。 VB6初心者でございます。 今、VB6からエクセルの制御を行っております。 タイトルにもございますが、エクセルが解放されず困っております。 正確に言いますと、下記プログラム単体で動かすと、エクセルが解放されるのですが、 このプログラムを、関数として、別プログラムに組み込んで使用しますと、エクセルが解放されなくなってしまいます。 組み込んだプログラムを終了すると、エクセルは解放されます。 当方、いろいろと調査したのですが、原因がわからず大変困っております。 どなたかご教授いただけませんでしょうか。 少々長いプログラムで、読みにくいかもしれませんが、よろしくお願い致します。 お忙しい所誠に恐縮ですが以上よろしくお願い致します。
開発環境 VB6 SP3 WinXP Pro SP2 Office2000 Standard IE6
Private Sub PPKInput() Dim Series As String 'KQかKQCか Dim Bunkatu As String '_2か_1(PPK管理図のファイル名の後ろの部分 06Ppk管理図KQ_2.xls) Dim fsoFolExi As New FileSystemObject Dim fsoFolCop As New FileSystemObject Dim fsoFilCop As New FileSystemObject Dim strPpkFolNam_Path As String 'PPK管理図のフォルダのパス Dim strPpkBacFolNam_Path As String 'Ppk管理図(バックアップ)のフォルダのパス Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet 'KQかKQCの判別 If Mid(InputKQCode, 3, 1) = "0" Or Mid(InputKQCode, 3, 1) = "M" Then 'InputKQCode(ex,KQM622N) Series = "KQ" Else Series = "KQC" End If If InStr(Mid(InputKQCode, 5, 3), "R") >= 2 Then 'InputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRの位置が2以上の場合 If Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "R", "00") >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRを00に変えた数(ex,1R0なら1000)が47以上の場合 Bunkatu = "_2" ElseIf Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "R", "00") < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1R0、1R2)のRを00に変えた数(ex,1R0なら1000)が47より小さい場合 Bunkatu = "_1" Else: Bunkatu = "" End If
ElseIf InStr(Mid(InputKQCode, 5, 3), "N") >= 2 Then 'InputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNの位置が2以上の場合 If Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "N", ".") >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNを.に変えた数(ex,1N6なら1.6)が47以上の場合 Bunkatu = "_2" ElseIf Series = "KQ" And Replace(Mid(InputKQCode, 5, 3), "N", ".") < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)のNを.に変えた数(ex,1N6なら1.6)が47より小さい場合 Bunkatu = "_1" Else: Bunkatu = "" End If
ElseIf Series = "KQ" And Mid(InputKQCode, 5, 3) >= 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)が47以上の場合 Bunkatu = "_2"
ElseIf Series = "KQ" And Mid(InputKQCode, 5, 3) < 47 Then 'series="KQ"かつInputKQCode(ex,KQM622N)の5個めから3つ(ex,1N6、10N)が47より小さい場合 Bunkatu = "_1"
Else: Bunkatu = "" End If
'Ppk管理図への入力 'Ppk管理図のフォルダ名(メイン) strPpkFolNam_Path = "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki
'Ppk管理図のフォルダ有無 If fsoFolExi.FolderExists(strPpkFolNam_Path) <> "true" Then 'Ppk管理図(原紙)フォルダを\\Kq-001\工程集計\工程不良集計\Ppk集計フォルダにコピーする fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _ "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" 'フォルダ名の変更 '”Ppk管理図(原紙)”フォルダの名前を、”Ppk管理図28”に変更する。 Name "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" _ As "\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki End If
Set xlApp = CreateObject("Excel.Application")
'Ppk管理図ファイルのオープン Set xlBook = xlApp.Workbooks.Open("\\Kq-001\工程集計\工程不良集計\Ppk集計" & "\Ppk管理図" _ & Gouki & "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls")
Set xlSheet = xlBook.Worksheets(L_Value)
'xlApp.Visible = True 'エクセルを表示 xlApp.Application.ScreenUpdating = True '画面の描画をONに戻す xlBook.Sheets(L_Value).Select '対象L値のシート選択 xlSheet.Range("A1:BA39").Select 'A1からBA39を選択 xlApp.ActiveWindow.Zoom = True
xlSheet.Range("A1").Select 'A1セルを選択
xlApp.Application.ScreenUpdating = False '画面の描画をOFFにする
If xlSheet.Cells(29, 51) = Empty Then 'Ppk管理図ファイルのセル(29行, 51列)が空の場合 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(0, 1) = Now '月 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(1, 0) = Now '日 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(2, 0) = P_p_k 'Ppk xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(3, 0) = Average 'アベレージ(%) xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(4, 0) = SEISANLot 'ロットNo xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(5, 0) = pstrPRGNo 'PRGNo xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(6, 0) = pstrYUUKOUMAKISUU '有効巻数 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(7, 0) = pstrPitch 'ピッチ/微調整 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(8, 0) = pstrMakihazimeichi '巻始位置/微調整 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(9, 0) = pstrNyuusenichi '入線位置 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(10, 0) = pstrSeisouKenmaCycle '清掃研磨サイクル Else xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(0, 1) = Now '月 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(1, 0) = Now '日 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(2, 0) = P_p_k 'Ppk xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(3, 0) = Average 'アベレージ(%) xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(4, 0) = SEISANLot 'ロットNo xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(5, 0) = pstrPRGNo 'PRGNo xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(6, 0) = pstrYUUKOUMAKISUU '有効巻数 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(7, 0) = pstrPitch 'ピッチ/微調整 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(8, 0) = pstrMakihazimeichi '巻始位置/微調整 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(9, 0) = pstrNyuusenichi '入線位置 xlSheet.Cells(29, xlApp.ActiveSheet.Columns.Count).End(xlToLeft).Offset(10, 0) = pstrSeisouKenmaCycle '清掃研磨サイクル xlApp.ActiveWindow.SelectedSheets.PrintOut Copies:=1 'Ppk管理図印刷 '29行3列目から39行52列目の数式と文字を削除する xlSheet.Range(xlSheet.Cells(29, 3), xlSheet.Cells(39, 52)).ClearContents
End If
'Ppk管理図ファイルの保存 xlBook.Save 'ブックの保存
'Ppk管理図のフォルダ名(バックアップ) strPpkBacFolNam_Path = "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki
'Ppk管理図のフォルダ有無(バックアップ) '\\Kq-001\SETKQFILE\工程不良集計\Ppk集計フォルダにフォルダ(ex、PPK管理図28)が存在するか調べる If fsoFolExi.FolderExists(strPpkBacFolNam_Path) <> "true" Then '存在しない場合 'フォルダのコピー '\\Kq-001\SETKQFILE\工程不良集計\Ppk集計フォルダに、PPK管理図(原紙)フォルダ(フォルダの中身全て)がコピーされる fsoFolCop.CopyFolder "\\Kq-001\工程集計\原紙ファイル\Ppk管理図(原紙)", _ "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\" 'フォルダ名の変更 'PPK管理図(原紙)フォルダの名前をPPK管理図28フォルダに変更する Name "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\" & "\Ppk管理図(原紙)" As _ "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\" & "\Ppk管理図" & Gouki
End If
'バックアップファイル(Ppk管理図)のコピー fsoFilCop.CopyFile ActiveWorkbook.Path & "\" & ActiveWorkbook.Name, _ "\\Kq-001\SETKQFILE\工程不良集計\Ppk集計" & "\Ppk管理図" & Gouki & _ "\06\06Ppk管理図" & Series & "" & Bunkatu & ".xls"
xlApp.Application.ScreenUpdating = True '画面の描画をONに戻す
'☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆ 'ここでエクセルが解放されません Set xlSheet = Nothing 'オブジェクトを解放 xlBook.Close 'Bookを閉じる Set xlBook = Nothing 'オブジェクトを解放 xlApp.Quit 'Quitメソッドを使ってExcelを終了 Set xlApp = Nothing 'オブジェクトを解放 '☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆☆ End Sub
|