このプログラムを使用してこの場所を開けません。別の場所を試してください。...

最新推荐文章于 2024-08-06 16:21:57 发布

weixin_30662109

最新推荐文章于 2024-08-06 16:21:57 发布

阅读量334

点赞数

文章标签： runtime

原文链接：http://www.cnblogs.com/guanmy/archive/2012/06/21/2557849.html

版权

Private Sub outExceldata(ByVal xlFilePath As String, ByVal SheetNum As Integer, _
                             ByVal dtTableSheet As DataTable, ByVal dtTableWB出力 As DataTable)
        ''プロジェクト→参照の追加→COM→Microsoft Excel *.* ObjectLibrary を参照して下さい
        '================== 起動時の処理 ===================
        Dim xlApp As Object = CreateObject("Excel.Application")
        Dim xlBooks As Object = xlApp.Workbooks

        Dim xlBook As Object = xlBooks.Open(xlFilePath)
        Dim xlSheets As Object = xlBook.Worksheets
        Dim xlSheet As Object = xlSheets.Item(1)

        Dim xlSheetMoto As Object = Nothing
        Dim xlSheetIchi As Object = Nothing
        Dim xlSheetColor As Object = Nothing
        Dim xlRange As Object = Nothing
        Dim xlRangeColor As Object = Nothing
        Dim xlHoge As Object = Nothing

Dim dtRow() As DataRow

        Dim intArgb0 As Integer = 0
        Dim intArgb1 As Integer = 0
        Dim intArgb2 As Integer = 0
        Dim strBackColorArgb As String = String.Empty

Dim strExcelName As String = "WhiteBoard" & CDate(Utility.GetDBTime).ToString("yyyyMMdd")

Try

xlApp.Visible = False 'Excelを表示(必ずとも表示しなくてもよい)

For intLoop = 1 To SheetNum - 1 Step 1

                'シートを指定位置にコピーする
                xlSheetMoto = DirectCast(xlSheets.Item(1), Excel.Worksheet)
                xlSheetIchi = DirectCast(xlSheets.Item(intLoop), Excel.Worksheet)
                xlSheetMoto.Copy(, xlSheetIchi)

            'For intLoop = 1 To SheetNum - 1 Step 1
            '    xlSheets.Copy(Before:=xlSheets.Item(intLoop))
            '    xlSheets.Item(intLoop).Name = dtTableSheet.Rows(intLoop - 1).Item(1)

            '    ''シートのｺﾋﾟｰ
            '    'xlSheet = xlSheets.Item(intLoop) 'シートの選択
            '    'xlSheet.Copy(Before:=xlBook.Worksheets(1)) 'シートのコピー
            '    'xlSheet = xlSheets.Item(1) '再度シートを選択
            '    'xlSheet.Name = intLoop 'シートに名前を付ける
            'Next

            For intLoop = 1 To SheetNum Step 1
                xlSheetColor = xlSheets.Item(intLoop)
                xlSheetColor.Select()
                xlRange = xlSheetColor.Range("A1")
                xlRange.Select()

strBackColorArgb = dtTableSheet.Rows(intLoop - 1).Item(2).ToString

                intArgb0 = Convert.ToInt32(strBackColorArgb.Substring(0, 2), 16)
                intArgb1 = Convert.ToInt32(strBackColorArgb.Substring(2, 2), 16)
                intArgb2 = Convert.ToInt32(strBackColorArgb.Substring(4, 2), 16)

Dim objColor As Color

objColor = Utility.Fn_Color_DB_ColorRGB(dtTableSheet.Rows(intLoop - 1).Item(2).ToString)

                xlRangeColor = xlSheetColor.Range("A1:G1")
                xlRangeColor.Select()
                xlHoge = xlRangeColor.Interior
                xlHoge.Color = RGB(objColor.R, objColor.G, objColor.B)

'xlRangeColor.Interior.Color = RGB(objColor.R, objColor.G, objColor.B)

xlSheetColor.Name = dtTableSheet.Rows(intLoop - 1).Item(1)

dtRow = dtTableWB出力.Select(" 依頼先 = '" & dtTableSheet.Rows(intLoop - 1).Item(0) & "' ")

For i = 0 To dtRow.Length - 1 Step 1

For j = 0 To dtTableWB出力.Columns.Count - 2 Step 1

xlSheets.Item(intLoop).Cells(i + 2, j + 1) = dtRow(i).Item(j)

''カーソル
xlSheets.Item(1).select()

If System.IO.File.Exists(xlFilePath.Substring(0, xlFilePath.Length - 1) & "s") = True Then

Try
System.IO.File.Delete(xlFilePath.Substring(0, xlFilePath.Length - 1) & "s")

                Catch ex As Exception
                    MessageBox.Show("Opening", "Error", MessageBoxButtons.OK, MessageBoxIcon.Warning)
                    Exit Sub

End Try

End If

            'ファイルの保存
            ' SaveFileDialog の新しいインスタンスを生成する (デザイナから追加している場合は必要ない)
            Dim SaveFileDialog1 As New SaveFileDialog()
            Dim res As DialogResult

' ダイアログのタイトルを設定する
SaveFileDialog1.Title = "名前を付けて保存"

            ' 初期表示するディレクトリを設定する
            If gstrSavePath <> String.Empty Then
                SaveFileDialog1.InitialDirectory = gstrSavePath
            End If

' 初期表示するファイル名を設定する
SaveFileDialog1.FileName = strExcelName

' ファイルの種類の初期設定を 2 番目に設定する (初期値 1)
'SaveFileDialog1.FilterIndex = 1

' ダイアログボックスを閉じる前に現在のディレクトリを復元する (初期値 False)
SaveFileDialog1.RestoreDirectory = True

' [ヘルプ] ボタンを表示する (初期値 False)
'SaveFileDialog1.ShowHelp = True

            ' 存在しないファイルを指定した場合は、
            ' 新しく作成するかどうかの問い合わせを表示する (初期値 False)
            'SaveFileDialog1.CreatePrompt = False

            ' 存在しているファイルを指定した場合は、
            ' 上書きするかどうかの問い合わせを表示する (初期値 True)
            SaveFileDialog1.OverwritePrompt = False

' 存在しないファイル名を指定した場合は警告を表示する (初期値 False)
'SaveFileDialog1.CheckFileExists = True

' 存在しないパスを指定した場合は警告を表示する (初期値 True)
'SaveFileDialog1.CheckPathExists = True

' 拡張子を指定しない場合は自動的に拡張子を付加する (初期値 True)
SaveFileDialog1.AddExtension = True

' 有効な Win32 ファイル名だけを受け入れるようにする (初期値 True)
'SaveFileDialog1.ValidateNames = True

res = SaveFileDialog1.ShowDialog()

' ダイアログを表示し、戻り値が [OK] の場合は、選択したファイルを表示する
If res = Windows.Forms.DialogResult.OK Then

xlApp.DisplayAlerts = False

                'oBook.SaveAs(saveFileDialog1.FileName, Excel.XlFileFormat.xlExcel8)
                If CType(xlApp.Version.ToString, Decimal) < 12 Then
                    xlBook.SaveAs(SaveFileDialog1.FileName)
                Else
                    xlBook.SaveAs(SaveFileDialog1.FileName, 56)
                End If

xlBook.Close()

xlApp.DisplayAlerts = True

gstrSavePath = SaveFileDialog1.FileName()
gstrSavePath = Mid(gstrSavePath, 1, InStrRev(gstrSavePath, "\"))

                '成功メッセージを呼び出し
                CommonMsg.showMsg(Me.Tag.ToString, ENU_MSGID.Finish, "WB出力")
            Else
                xlApp.DisplayAlerts = False
                xlBook.Close()
                xlApp.DisplayAlerts = True
            End If

' 不要になった時点で破棄する (正しくはオブジェクトの破棄を保証するを参照)
SaveFileDialog1.Dispose()

            '================== 終了処理 =====================
            Try
                'COMオブジェクトの解放
                COM_MRComObject(xlHoge)
                COM_MRComObject(xlRangeColor)
                COM_MRComObject(xlRange)
                COM_MRComObject(xlSheetColor)
                COM_MRComObject(xlSheetMoto)
                COM_MRComObject(xlSheetIchi)
                COM_MRComObject(xlSheet)            'xlSheet の解放
                COM_MRComObject(xlSheets)           'xlSheets の解放
                COM_MRComObject(xlBook)             'xlBook の解放
                xlBooks.Close()
                COM_MRComObject(xlBooks)            'xlBooks の解放
                xlApp.Quit()
                COM_MRComObject(xlApp)              'xlApp を解放
            Catch ex As Exception

End Try

        Catch ex As Exception
            '異常処理
            EXHelper.ProcessEx(ex, Me.Tag.ToString)

Finally

'デフォルトのカーソル
Me.Cursor = Cursors.Default

'================== 終了処理 =====================

            'COMオブジェクトの解放
            COM_MRComObject(xlHoge)
            COM_MRComObject(xlRangeColor)
            COM_MRComObject(xlRange)
            COM_MRComObject(xlSheetColor)
            COM_MRComObject(xlSheetMoto)
            COM_MRComObject(xlSheetIchi)
            COM_MRComObject(xlSheet)            'xlSheet の解放
            COM_MRComObject(xlSheets)           'xlSheets の解放
            COM_MRComObject(xlBook)             'xlBook の解放
            COM_MRComObject(xlBooks)            'xlBooks の解放
            COM_MRComObject(xlApp)              'xlApp を解放

GC.Collect()

            xlHoge = Nothing
            xlRangeColor = Nothing
            xlRange = Nothing
            xlSheetColor = Nothing

            xlSheetMoto = Nothing
            xlSheetIchi = Nothing
            xlSheet = Nothing
            xlSheets = Nothing
            xlBook = Nothing
            xlBooks = Nothing
            xlApp = Nothing
            '-------------------------------------------------------------------------
            'テスト中は、下記コードを上記 Excel 終了後に実施するようにして下さい。
            'この方法だと強制的にガベージコレクションをしなくても
            'キチンと終了しています。（プロセスが終了している・タスクマネージャに表示していない）
            '[Ctrl]+[Alt]+[Del]キーを押してWindows タスクマネージャ→プロセスに
            'Excel.EXE が残っていないかを確認して下さい。
            '★☆★☆★☆★☆★☆ Debug 中は下記を実行して確認しながら進めて下さい ★☆★☆★☆★☆★☆
            'Dim st As Integer = System.Environment.TickCount
            'Do While System.Environment.TickCount - st < 5000
            '    Application.DoEvents()
            '    System.Threading.Thread.Sleep(500)
            '    If Process.GetProcessesByName("Excel").Length = 0 Then
            '        MessageBox.Show("Excel.EXE は解放されました。")
            '        Exit Do
            '    End If
            'Loop
            'If Process.GetProcessesByName("Excel").Length >= 1 Then
            '    MessageBox.Show("まだ Excel.EXE が起動しています。")
            '    '一度メッセージボックスを表示すると解放されるようなので再度確認
            '    If Process.GetProcessesByName("Excel").Length = 0 Then
            '        MessageBox.Show("Excel.EXE は解放されました。")
            '    End If
            'End If
            '--------------------------------------------------------------------------
        End Try
    End Sub

    '*-------------------------------------------------------------------*
    ' 【機　　能】Excelのシートコピー
    ' 【引き数】xlBook : Excelワークブック
    '             SheetNoMoto : コピー元シート番号
    '             SheetNoIchi : コピー位置のシート番号
    '             BeforeOrAfter : コピー位置の前(True)or後ろ(False)
    ' 【返り値】-
    '*-------------------------------------------------------------------*
    Public Sub CE_ExcelSheetCopy(ByVal xlBook As Excel.Workbook, ByVal SheetNoMoto As Integer, ByVal SheetNoIchi As Integer, ByVal BeforeOrAfter As Boolean)
        Dim xlSheets As Excel.Sheets
        Dim xlSheetMoto As Excel.Worksheet
        Dim xlSheetIchi As Excel.Worksheet

        Try
            'シートを指定位置にコピーする
            xlSheets = xlBook.Worksheets
            xlSheetMoto = DirectCast(xlSheets.Item(SheetNoMoto), Excel.Worksheet)
            xlSheetIchi = DirectCast(xlSheets.Item(SheetNoIchi), Excel.Worksheet)
            If BeforeOrAfter = True Then
                xlSheetMoto.Copy(xlSheetIchi)
            Else
                xlSheetMoto.Copy(, xlSheetIchi)
            End If

            'COMオブジェクトの解放
            COM_MRComObject(xlSheetMoto)
            COM_MRComObject(xlSheetIchi)
            COM_MRComObject(xlSheets)

        Catch ex As Exception
            MessageBox.Show(ex.Message, "Err", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub

    '*-------------------------------------------------------------------*
    ' 【機　　能】COMオブジェクトの解放
    ' 【引き数】objCom : COMオブジェクト
    ' 【返り値】-
    '*-------------------------------------------------------------------*
    Public Sub COM_MRComObject(ByVal objCom As Object)
        'COM オブジェクトの使用後、明示的に COM オブジェクトへの参照を解放する
        Try
            '提供されたランタイム呼び出し可能ラッパーの参照カウントをデクリメントします
            If Not objCom Is Nothing AndAlso System.Runtime.InteropServices. _
                                                      Marshal.IsComObject(objCom) Then
                Dim I As Integer
                Do
                    I = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
                Loop Until I <= 0
            End If
        Catch
        Finally
            objCom = Nothing
        End Try
    End Sub

这个问题找两天了。终于知道是那儿的问题了。

原来是路径的问题。如果 SaveFileDialog1.InitialDirectory的值付的不正确.就会有

[このプログラムを使用してこの場所を開けません。別の場所を試してください。]

这个问题.

转载于:https://www.cnblogs.com/guanmy/archive/2012/06/21/2557849.html

weixin_30662109

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
このプログラムを使用してこの場所を開けません。別の場所を試してください。...

Private Sub outExceldata(ByVal xlFilePath As String, ByVal SheetNum As Integer, _ ByVal dtTableSheet As DataTable, ByVal dtTableWB出力 As DataTable) ''プロジェクト→参照の追加→COM...
复制链接

扫一扫