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

タイトル ： Re^4: EXCELへの印字部分処理に関して
投稿日： 2007/10/12(Fri) 13:46
投稿者： ジーク
ご返答ありがとうございます
> 修正後のソースを提示してみてください。

    Public Sub ExcelPrint()

        Dim strFilePath As String = "Ｅｘｃｅｌファイル名"

        Dim xlsApp As Object = Server.CreateObject("Excel.Application")
        Dim xlsBooks As Excel.Workbooks = xlsApp.Workbooks
        Dim xlsBook As Excel.Workbook = xlsBooks.Open(strFilePath)
        Dim xlsSheets As Excel.Sheets = xlsBook.Worksheets
        Dim xlsSheet As Excel.Worksheet = xlsSheets.Item(1)

        Dim dicXlsName As New Dictionary(Of String, String)


        Dim strScript As String = ""
        Dim strMsg As String = ""

        Dim pd As New System.Drawing.Printing.PrintDocument                 'PrintDocumentの作成
        Dim defaultPrinterName As String = pd.PrinterSettings.PrinterName   'プリンタ名の取得

        Try
            With xlsApp
                .Visible = False            'Excelを非表示
                .DisplayAlerts = False      'メッセージの非表示
                .ScreenUpdating = False     '再描画無効
            End With

            SetDictionary_XlsNameData(xlsBook, dicXlsName)

            '印字するデータを設定します
            Get_Name_Data()


            OUT_XLS_Data(xlsSheet, "NAME", dicXlsName)
            OUT_XLS_Data(xlsSheet, "Addr", dicXlsName)


            'EXCELを保存したことにする
            xlsBook.Saved = True

            '通常使うプリンターへ印刷する
            xlsSheet.PrintOut(ActivePrinter:=defaultPrinterName)

        Catch ex As Exception
            'エラー処理
            strMsg = ex.Message

            MsgBox(strMsg)

        Finally
            'ここで使用したEXCEL関連のオブジェクトの解放を行います
            MRComObject(xlsSheet)
            MRComObject(xlsSheets)
            xlsBook.Close(False)
            MRComObject(xlsBook)
            MRComObject(xlsBooks)
            xlsApp.Quit()
            MRComObject(xlsApp)
            MRComObject(dicXlsName)

        End Try
    End Sub

----------------------------------------------------------------------
    Private Sub OUT_XLS_Data(ByVal pXlsWorkSheet As Excel.Worksheet, _
                             ByVal pStrXlsCellName As String, _
                             ByVal pDicXlsNames As Dictionary(Of String, String))

        Dim udt_RptData_Test() As udt_RptData_Test_Tag = Nothing

        Dim xlsRange As Excel.Range = Nothing
        Dim xlsRangeObj As Excel.Range = Nothing


        Dim intCellObjCol As Integer = 0
        Dim intCellObjRow As Integer = 0

        Dim strBuff As String = ""
        Dim intLoopCount As Integer

        Try

            udt_RptData_Test = DirectCast(ViewState("TestData"), udt_RptData_Test_Tag())

            If pDicXlsNames.ContainsKey(pStrXlsCellName) = False Then
                Exit Try
            End If



            If Not udt_RptData_Test Is Nothing Then
                xlsRangeObj = pXlsWorkSheet.Range(pStrXlsCellName)
                intCellObjRow = xlsRangeObj.Row
                intCellObjCol = xlsRangeObj.Column

                For intLoopCount = LBound(udt_RptData_Test) To UBound(udt_RptData_Test)
                    'For intLoopCount = 0 To 0


                    Select Case pStrXlsCellName
                        Case "NAME"
                            strBuff = udt_RptData_Test(intLoopCount).strName
                        Case "Addr"
                            strBuff = udt_RptData_Test(intLoopCount).strAddr
                    End Select

                    xlsRange = xlsRangeObj(intCellObjRow + intLoopCount, intCellObjCol)
                    xlsRange.Value = strBuff

                    MRComObject(xlsRange)

                Next intLoopCount

                MRComObject(xlsRangeObj)

            End If

        Catch ex As Exception
            MsgBox(ex.Message)

        Finally

            MRComObject(xlsRange)
            MRComObject(xlsRangeObj)

            MRComObject(pStrXlsCellName)
            MRComObject(pXlsWorkSheet)

        End Try

    End Sub

上記のように使用し
魔界の仮面弁士さんに提示していただいた解放関数を
使用するとエラーが発生及び解放が行われません

長々と書いてしまいましたが宜しくお願いします
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

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