tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]  [ワード検索]  [Home]

タイトル 解決しました。申し訳ありませんでした
投稿日: 2005/01/20(Thu) 11:41
投稿者ひろぼ
[OSのVer]:Windows    [VBのVer]:VB.NET  
自己解決しました。本当にその都度、解放しなければならないのですね。
大変申し訳ありませんでした。
一応、コードをのせておきます。大変失礼いたしました。

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles Button1.Click

        Dim iSheetsCount As Integer
        Dim sSheetName() As String
        Dim intLoop As Integer
        Dim iRow As Integer
        Dim sFileName As String = "C:\Test.xls"     'シート数3
        '================== 起動時の処理 =================== 
        Dim xlsApp As New Excel.Application
        Dim xlsBooks As Excel.Workbooks = xlsApp.Workbooks
        '既存のファイルを開く場合
        Dim xlsBook As Excel.Workbook = xlsBooks.Open(sFileName)
        Dim xlsSheets As Excel.Sheets = xlsBook.Worksheets
        Dim xlsSheet As Excel.Worksheet
        Dim xlsCells As Excel.Range
        Dim xlsRange As Excel.Range
        xlsApp.DisplayAlerts = False

        '全シート名を取得する
        iSheetsCount = xlsSheets.Count
        ReDim sSheetName(iSheetsCount)
        For intLoop = 1 To iSheetsCount
            xlsSheet = xlsSheets(intLoop)
            sSheetName(intLoop) = xlsSheet.Name
            MRComObject(xlsSheet)            'xlSheet の開放
        Next
        '1シート目を取得
        xlsSheet = xlsSheets(1)
        'データを入れる
        For iRow = 1 To 30
            xlsCells = xlsSheet.Cells
            xlsRange = xlsCells(iRow, 1)
            xlsRange.Value = CStr(iRow)
            MRComObject(xlsCells)            'xlRange の開放
            MRComObject(xlsRange)            'xlSheet の開放
        Next
        '1ページ目(30行)をコピーして3ページ分にする
        pCopyPaste(xlsSheet, 1, 30, 30, 2)
        MRComObject(xlsSheet)            'xlSheet の開放

        '2ページ目を削除する
        xlsSheet = xlsSheets(2)
        xlsSheet.Delete()
        MRComObject(xlsSheet)            'xlSheet の開放

        xlsSheets.Select()
        'ファイルを保存する
        xlsBook.SaveAs("C:\Test2.xls")
        Erase sSheetName
        xlsApp.DisplayAlerts = True
        '================== 終了時の処理 =================== 
        MRComObject(xlsSheets)           'xlSheets の開放
        xlsBook.Close()             'xlBook を閉じる
        MRComObject(xlsBook)             'xlBook の開放
        MRComObject(xlsBooks)            'xlBooks の開放
        xlsApp.Quit()                    'Excelを閉じる    
        MRComObject(xlsApp)              'xlApp を開放

    End Sub


    Private Sub pCopyPaste(ByVal xlsSheet As Excel.Worksheet, _
                    ByRef iStart As Integer, ByRef iEnd As Integer, ByVal i1PageCnt As
Integer, ByVal iCount As Integer)

        Dim intLoop As Integer
        Dim xlsCells As Excel.Range
        Dim xlsRows As Excel.Range
        Dim xlsRange As Excel.Range

        xlsRows = xlsSheet.Rows
        xlsRange = xlsRows(iStart & ":" & iEnd)
        xlsRange.Copy()
        MRComObject(xlsRange) 'xlsRange の開放
        xlsRange = xlsRows(iEnd + 1 & ":" & iEnd + i1PageCnt * iCount)
        xlsRange.Select()
        xlsRange.PasteSpecial(Excel.XlPasteType.xlPasteAll)
        xlsSheet.Select()
        MRComObject(xlsRange) 'xlsRange の開放
        MRComObject(xlsRows) 'xlsRows の開放

        '改ページを設定しなおす処理
        xlsCells = xlsSheet.Cells
        xlsCells.PageBreak = Excel.XlPageBreak.xlPageBreakNone
        MRComObject(xlsCells) 'xlsCells の開放
        xlsRows = xlsSheet.Rows
        For intLoop = 0 To iCount
            xlsRange = xlsRows((iEnd + i1PageCnt * intLoop) + 1)
            xlsRange.PageBreak = Excel.XlPageBreak.xlPageBreakManual
            MRComObject(xlsRange) 'xlsRange の開放
        Next
        MRComObject(xlsRows) 'xlsRows の開放

    End Sub

    Private Sub MRComObject(ByVal objXl As Object)
        'Excel 終了処理時のプロシージャ
        Try
            '提供されたランタイム呼び出し可能ラッパーの参照カウントをデクリメントします
            System.Runtime.InteropServices.Marshal.ReleaseComObject(objXl)
        Catch
        Finally
            objXl = Nothing
        End Try
    End Sub

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。