| 投稿日 | ： 2004/08/09(Mon) 20:19 |
| 投稿者 | ： みっち〜 |
| ＵＲＬ | ： |
| タイトル | ： Re^4: VBからEXCELファイルを作成し、完了後ファイルがうまく開かない |
> 又、間違った場合等は、下部から修正もできます。
度々申し訳ありません。
再度コードを投稿します。
> 又、プロセスにExcelが残っていないか確認して下さい。
下のコードでは4回ループさせていますが、再度確認したところ、
（作成するファイルの数‐２）の数のEXCELがプロセスに残っていました。
なので、出力させたいファイルが２つまでのときは問題がなかったです。
残ったままのプロセスを終了させるにはどのような処理を行えば良いのでしょうか。
以下コード全文です。
よろしくおねがいします。
↓↓↓↓
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_RESTORE = 9
Private Const SW_SHOWMAXIMIZED = 3
Const sPath As String = "D:\work"
Private Sub Command1_Click()
Dim sFileName As String 'ファイル名（フルパス）
Dim iRc As Integer
Dim ilp As Integer
If gfb_OutPutExcel() Then
MsgBox "Ｅｘｃｅｌファイルの作成が完了しました。", vbOKOnly + vbInformation
'フォルダを開く
ShellExecute Form1.hwnd, "Open", sPath, _
vbNullString, vbNullString, SW_RESTORE
End If
End Sub
Public Function gfb_OutPutExcel() As Boolean
Dim oExcelApp As Object 'Excelオブジェクト
Dim oDataSheet2 As Object 'Excelシートオブジェクト
Dim sFileName As String 'Exlce出力ファイル名（フルパス）
Dim bFlg As Boolean
Dim ilp As Integer
Dim flgOpen As Boolean
Dim giFIdx As Integer
Dim GM_FName() As String
gfb_OutPutExcel = False
flgOpen = False
Do Until ilp = 4
bFlg = False
If flgOpen = True Then
'----- Excelファイルデータ保存 -----
oDataSheet2.SaveAs (sFileName)
Dim w
For Each w In oExcelApp.Workbooks
w.Save
Next w
oExcelApp.Quit
Set oExcelApp = Nothing
Set oDataSheet2 = Nothing
flgOpen = False
End If
If Dir(App.Path & "\wk_book1.xls") <> "" Then
Kill App.Path & "\wk_book1.xls"
End If
'出力ファイル名保存----------
giFIdx = giFIdx + 1
ReDim Preserve GM_FName(giFIdx)
sFileName = sPath & "\" & giFIdx & ".xls" '出力ファイル名
GM_FName(giFIdx) = sFileName
'---------------------------
'----- 雛形のExcelをコピーする -----
FileCopy App.Path & "\book1.xls", App.Path & "\wk_book1.xls"
'----- Excelを開く -----
Set oExcelApp = CreateObject(Class:="Excel.Application")
oExcelApp.Workbooks.Add (App.Path & "\wk_book1.xls")
Set oDataSheet2 = oExcelApp.ActiveWorkbook.Worksheets("sheet1")
flgOpen = True
'-----シートへ出力-------------------------------------
oDataSheet2.cells(4, 2).Value = "タイトル１"
oDataSheet2.cells(4, 4).Value = "タイトル２"
ilp = ilp + 1
Loop
If flgOpen = True Then
'----- Excelファイルデータ保存 -----
oDataSheet2.SaveAs (sFileName)
For Each w In oExcelApp.Workbooks
w.Save
Next w
oExcelApp.Quit
Set oExcelApp = Nothing
Set oDataSheet2 = Nothing
End If
gfb_OutPutExcel = True
End Function