[リストへもどる]   [VBレスキュー(花ちゃん)]
一括表示

投稿時間: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
-------------------------------

投稿時間:2004/12/06(Mon) 10:27
投稿者名:LESIA
Eメール:
URL :
タイトル:
Re: Excelが終了しません。
ここの「Excel・Word関係」の「Excel のタスクを正常に終了できない現象」のところは
読みましたか?
読めば解決できる問題ですよ。

>     'シート名選択
>     ActiveSheet.Name = "設備投資・状況"
>     'mySheetName = InputBox("保存するいシート名を入力してください", "シート名設定")
>     'ActiveSheet.Name = mySheetName

投稿時間:2004/12/06(Mon) 17:25
投稿者名:SK
Eメール:
URL :
タイトル:
Re^2: Excelが終了しません。
> ここの「Excel・Word関係」の「Excel のタスクを正常に終了できない現象」のところは
> 読みましたか?
> 読めば解決できる問題ですよ。
>
> >     'シート名選択
> >     ActiveSheet.Name = "設備投資・状況"
> >     'mySheetName = InputBox("保存するいシート名を入力してください", "シート名設定")
> >     'ActiveSheet.Name = mySheetName

ご指摘、ありがとうございます。
自分なりにその部分は読んだつもりです。
ただ上記箇所(参考か指摘か解りませんが)の部分にはオブジェクトの指定が有りませんでしたので
追加し、実行しましたが、結果は同じでした。
初心者のため、よくわかりません。(勉強不足で申し訳ありません。)
お手数をお掛けして申し訳ありませんが、もう少しヒントを頂けないでしょうか?
よろしくお願いします。

投稿時間:2004/12/06(Mon) 17:51
投稿者名:GOD
Eメール:
URL :
タイトル:
Re: Excelが終了しません。
export_clickに分岐した(コモンダイアログでキャンセルを押下等)時はオブジェクトを解放していないので
残りそうですね。
あと、xlApp.Quitした後にxlBook.Close (False)してるけど大丈夫なのかな?

PS.関数化できるとこはした方がいいよ。(読む側も辛いです。)

投稿時間:2004/12/06(Mon) 23:19
投稿者名:SK
Eメール:
URL :
タイトル:
Re^2: Excelが終了しません。
> export_clickに分岐した(コモンダイアログでキャンセルを押下等)時はオブジェクトを解放していないので
> 残りそうですね。
> あと、xlApp.Quitした後にxlBook.Close (False)してるけど大丈夫なのかな?
>
> PS.関数化できるとこはした方がいいよ。(読む側も辛いです。)

GODさん、ヒントをありがとうございます。
“xlApp.Quitした後にxlBook.Close (False)してるけど大丈夫なのかな?”で
位置を変えてみたらExcelは終了しました。(複数回行っても終了します。)
尚、キャンセル時の流れはこれから作成します。
また関数化にも今後挑戦してます。
初心者なのでお聞きしますが、関数化とはどのような場合およびどのような
ものを行うのでしょうか?
お教え願えないでしょうか?
よろしくお願いします。

投稿時間:2004/12/07(Tue) 02:17
投稿者名:GOD
Eメール:
URL :
タイトル:
Re^3: Excelが終了しません。
> 初心者なのでお聞きしますが、関数化とはどのような場合およびどのような
> ものを行うのでしょうか?
>
・一つの機能として分離できるもの。(今回だとコモンダイアログで名前を取得する箇所)

・一つに纏められるところ(今回だと↓のところ。.CellsのRow, Colを引数で渡してあげれば一つの関
数で対応できますよね。下でも同じ事を複数個やっているのでかなりの行削減になるのでは。)
        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

・一つの処理が余りにも長くなってしまいそうなところ(今回だと.ColumnWidthしてるとことか。これは
機能と分離〜も含むでしょうけど)

・再利用するような処理(エクセル終了処理部分とか。)
> キャンセル時の流れはこれから作成します。
で再利用できますよね。

PS.言葉は違えど元となっている理念は同じかと。

投稿時間:2004/12/07(Tue) 12:58
投稿者名:SK
Eメール:
URL :
タイトル:
Re^4: Excelが終了しません。
> > 初心者なのでお聞きしますが、関数化とはどのような場合およびどのような
> > ものを行うのでしょうか?
> >
> ・一つの機能として分離できるもの。(今回だとコモンダイアログで名前を取得する箇所)
>
> ・一つに纏められるところ(今回だと↓のところ。.CellsのRow, Colを引数で渡してあげれば一つの関
> 数で対応できますよね。下でも同じ事を複数個やっているのでかなりの行削減になるのでは。)
>         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
>
> ・一つの処理が余りにも長くなってしまいそうなところ(今回だと.ColumnWidthしてるとことか。これは
> 機能と分離〜も含むでしょうけど)
>
> ・再利用するような処理(エクセル終了処理部分とか。)
> > キャンセル時の流れはこれから作成します。
> で再利用できますよね。
>
> PS.言葉は違えど元となっている理念は同じかと。

ご教授、ありがとうございます。
これを参考に挑戦してみます。
今後、お尋ねすることが必ずあるはずですのでまたよろしくお願いします。