投稿時間:2004/12/05(Sun) 23:35 投稿者名:SK
Eメール:
URL :
タイトル:Excelが終了しません。
VB6 Sp6です。 【処理の説明】 あるAccessDB(Office2003)よりデーターを抽出し、フレックスグリッドに表示。 “ファイルに出力”のボタンを押下すると表示されているデーターをExcelファイル に保存する。 このとき、グリッドに表示されているのは1レコードの一部なので再度、キーをもとに すべてのフィールドを抽出し、保存する処理なのですが下記事項で困っています。
1.Excelがメモリーに残っている。 2.連続で“ファイルに出力”ボタンが押下できない。 (この連続とは表示するデーターを表示条件で変更してです。)
いろいろ調べて試していますが自分では解りません。 どこを変更すればいいのかお教え願えないでしょうか? よろしくお願いします。
下記は“ファイルに出力”ボタンを押下したときのロジックです。 -------------------------- ロジック Private Sub Command4_Click() On Error GoTo export_click
'StatusBar1.Style = sbrNormal 'StatusBar1.Panels.Item(1) = "処理中" 'ステータスバー表示 StatusBar1.Style = sbrSimple StatusBar1.SimpleText = "EXCELファイルにデーターを書き込み中、しばらくお待ちください。" 'マウスカーソルを待機中に変更 'Me.MousePointer = vbHourglass
Set rec = New ADODB.Recordset 'レコードセットのデータをExcelに保存 Dim rec_rowNum As Integer Dim rec_colNum As Integer Dim xl_rowNum As Integer Dim xl_colNum As Integer Dim moji As String Dim mySheetName As String
' 変数にオブジェクトの参照を代入します。Add メソッドを使って ' 新規 workbookとworksheet オブジェクトを作成。 Set xlApp = CreateObject("Excel.Application") Set xlBook = xlApp.Workbooks.Add() Set xlSheet = xlBook.Worksheets(1)
'エクセルを表示しない xlApp.Visible = False '列名取得sql strSql = "SELECT *, ID FROM 設備投資状況;" With rec .ActiveConnection = cnn .CursorLocation = adUseClient .CursorType = adOpenStatic '.LockType = adLockOptimistic .LockType = adLockReadOnly .Properties("IRowsetIdentity").Value = True .Open strSql End With Colcount = rec.Fields.Count 'レコードセットの列の数を調べる rec_colNum = 0 '列カウント初期化 (SQL 抽出レコード) xl_rowNum = 1 'レコードカウント初期化 (Excel レコード) xl_colNum = 1 '列カウント初期化 (Excel レコード) Do While rec_colNum < Colcount '列の数とレコードセットの比較 With xlSheet.Cells .Item(xl_rowNum, xl_colNum).Value = rec.Fields(rec_colNum).Name 'Excelの列に配列を入れる End With With xlSheet.Cells(xl_rowNum, xl_colNum) .Font.Size = 11 'フォントサイズ .Font.Name = "MS P明朝" 'フォントの種類 .Font.Bold = True '太字に設定 .HorizontalAlignment = xlHAlignCenter '横中央揃え .VerticalAlignment = xlVAlignCenter '縦中央揃え .Interior.ColorIndex = 36 'セル内背景色セット End With rec_colNum = rec_colNum + 1 '配列のカラムを1移動 xl_colNum = xl_colNum + 1 'Excel 列 を1移動 Loop Set rec = Nothing Set rec = New ADODB.Recordset '実際のレコード取得 'sql 自動生成 strSql = "SELECT *, ID " strFrom = "FROM 設備投資状況 " strWhere = "" strorder = "ORDER BY 計画No, 申請日"
strSql = strSql & strFrom & " WHERE " 'フィールドをセット rowNum = 1 Do While rowNum < Rowcount + 1 '見出し部分をのぞきカウントさせる With MSFlexGrid1 strWhere = strWhere & " or (ID = " & .TextMatrix(rowNum, 0) & ")" End With rowNum = rowNum + 1 '配列のレコード1行移動 Loop 'strWhereは頭の" OR "を取り除く為Mid()で4桁目以降を取得する strSql = strSql & Mid(strWhere, 4) & strorder & ";" MsgBox strSql With rec .ActiveConnection = cnn .CursorLocation = adUseClient .CursorType = adOpenStatic '.LockType = adLockOptimistic .LockType = adLockReadOnly .Properties("IRowsetIdentity").Value = True .Open strSql End With Colcount = rec.Fields.Count 'レコードセットの列の数を調べる Rowcount = rec.RecordCount '行の数を取得する MsgBox Colcount '列 MsgBox Rowcount '行:レコード数 'Excelフォーマット With xlSheet .Columns(1).ColumnWidth = 3 .Columns(2).ColumnWidth = 11 .Columns(3).ColumnWidth = 8 .Columns(4).ColumnWidth = 28 .Columns(5).ColumnWidth = 11 .Columns(6).ColumnWidth = 5 .Columns(7).ColumnWidth = 53 .Columns(8).ColumnWidth = 5 .Columns(9).ColumnWidth = 12 .Columns(10).ColumnWidth = 12 .Columns(11).ColumnWidth = 12 .Columns(12).ColumnWidth = 12 .Columns(13).ColumnWidth = 12 .Columns(14).ColumnWidth = 12 .Columns(15).ColumnWidth = 11 .Columns(16).ColumnWidth = 11 .Columns(17).ColumnWidth = 10 .Columns(18).ColumnWidth = 10 .Columns(19).ColumnWidth = 12 .Columns(20).ColumnWidth = 10 .Columns(21).ColumnWidth = 10 .Columns(22).ColumnWidth = 10 .Columns(23).ColumnWidth = 10 .Columns(24).ColumnWidth = 40 .Columns(9).NumberFormat = "@" .Columns(10).NumberFormat = "@" .Columns(11).NumberFormat = "@" .Columns(12).NumberFormat = "@" .Columns(13).NumberFormat = "@" .Columns(14).NumberFormat = "\\#,###,###,##0" .Columns(19).NumberFormat = "\\#,###,###,##0" End With 'シート名選択 ActiveSheet.Name = "設備投資・状況" 'mySheetName = InputBox("保存するいシート名を入力してください", "シート名設定") 'ActiveSheet.Name = mySheetName rec_rowNum = 0 'レコードカウント初期化 (SQL 抽出レコード) xl_rowNum = 2 'レコードカウント初期化 (Excel レコード 2行目より)
Do While Not rec.EOF And rec_rowNum <= Rowcount + 1 '見出し部分を加えてカウントさせる rec_colNum = 0 'カウンタの初期化 xl_colNum = 1 'Excel 列 初期化 Do While rec_colNum < Colcount '列の数とレコードセットの比較 With xlSheet.Cells If IsNull(rec.Fields(rec_colNum)) = True Then .Item(xl_rowNum, xl_colNum).Value = "" Else .Item(xl_rowNum, xl_colNum).Value = rec.Fields(rec_colNum).Value If rec_colNum = 13 Then '申請金額 .Item(xl_rowNum, xl_colNum) = rec.Fields(rec_colNum).Value End If If rec_colNum = 18 Then '決裁金額 .Item(xl_rowNum, xl_colNum) = rec.Fields(rec_colNum).Value End If End If rec_colNum = rec_colNum + 1 '配列のカラムを1移動 xl_colNum = xl_colNum + 1 'Excel 列 を1移動 End With Loop rec_rowNum = rec_rowNum + 1 '行のレコード1行移動 xl_rowNum = xl_rowNum + 1 'Excelのレコード1行移動 rec.MoveNext 'レコードセットの改行 Loop '申請額、決裁額 合計値計算 表示 xlSheet.Cells(Rowcount + 2, 13).Value = "合計" With xlSheet.Cells(Rowcount + 2, 13) .Font.Size = 11 'フォントサイズ .Font.Name = "MS P明朝" 'フォントの種類 .Font.Bold = True '太字に設定 .HorizontalAlignment = xlHAlignCenter '横中央揃え .VerticalAlignment = xlVAlignCenter '縦中央揃え .Interior.ColorIndex = 36 'セル内背景色セット End With xlSheet.Cells(Rowcount + 2, 18).Value = "合計" With xlSheet.Cells(Rowcount + 2, 18) .Font.Size = 11 'フォントサイズ .Font.Name = "MS P明朝" 'フォントの種類 .Font.Bold = True '太字に設定 .HorizontalAlignment = xlHAlignCenter '横中央揃え .VerticalAlignment = xlVAlignCenter '縦中央揃え .Interior.ColorIndex = 36 'セル内背景色セット End With xlSheet.Cells(Rowcount + 2, 14).Formula = "=SUM(N1:" & "N" & Rowcount + 1 & ")" With xlSheet.Cells(Rowcount + 2, 14) .Font.Size = 10 'フォントサイズ .Font.Name = "MS P明朝" 'フォントの種類 .Font.Bold = True '太字に設定 .HorizontalAlignment = xlHAlignCenter '横中央揃え .VerticalAlignment = xlVAlignCenter '縦中央揃え .Interior.ColorIndex = 36 'セル内背景色セット End With xlSheet.Cells(Rowcount + 2, 19).Formula = "=SUM(S1:" & "S" & Rowcount + 1 & ")" With xlSheet.Cells(Rowcount + 2, 19) .Font.Size = 10 'フォントサイズ .Font.Name = "MS P明朝" 'フォントの種類 .Font.Bold = True '太字に設定 .HorizontalAlignment = xlHAlignCenter '横中央揃え .VerticalAlignment = xlVAlignCenter '縦中央揃え .Interior.ColorIndex = 36 'セル内背景色セット End With '表に罫線を引く 指定範囲に格子の罫線を引く xlSheet.Range("A1:" & "X" & Rowcount + 1).Borders.LineStyle = xlContinuous '実線 '表の外枠を太線に xlSheet.Range("A1:" & "X" & Rowcount + 1).Borders(xlEdgeTop).LineStyle = xlGray75 xlSheet.Range("A1:" & "X" & Rowcount + 1).Borders(xlEdgeLeft).LineStyle = xlGray75 xlSheet.Range("A1:" & "X" & Rowcount + 1).Borders(xlEdgeRight).LineStyle = xlGray75 xlSheet.Range("A1:" & "X" & Rowcount + 1).Borders(xlEdgeBottom).LineStyle = xlGray75 '項目欄を二重線で区切る xlSheet.Range("A1:X1").Borders(xlEdgeBottom).LineStyle = xlDouble 'DoEvents 'ステータバー 消去 StatusBar1.SimpleText = "" 'マウスカーソルをデフォルトに戻す 'Me.MousePointer = vbDefault 'コモンダイアログボックスを利用 With CommonDialog1 .CancelError = True
.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly .Filter = "Microsoft Office Excel ブック (*.xls)|*.xls" '最初に表示するファイルの種類の設定 .FilterIndex = 1 'ファイル名に表示するダイアログボックスを表示する .FileName = "無題" 'コモンダイアログボックスを中央に表示 '.Center = True 'ファイルを保存するダイアログボックスを表示する .ShowSave '内容をファイルへ出力 'xlSheet.SaveAs .FileName xlBook.SaveAs .FileName
End With 'DoEvents 'If Err.Number = cdlCancel Then Exit Sub xlBook.Windows(1).Visible = True xlApp.DisplayAlerts = False ' Quit メソッドを使って Excel を終了し。 xlApp.Quit ' オブジェクトを解放します。 Set xlSheet = Nothing xlBook.Close (False) Set xlBook = Nothing Set xlApp = Nothing
'ガベージコレクションのメモリの解放 'system.GC.Collect Exit Sub export_click: 'ファイル保存で Cancel をクリック 'キャンセルボタンが押されたときは、エラー処理を抜ける If Err.Number = 32755 Or 1004 Then Exit Sub End If 'メッセージボックスを表示して、エラー番号と内容を表示する MsgBox Err.Number & Err.Description
End Sub -------------------------------
|