このプログラムを使用してこの場所を開けません。 別の場所を試してください。
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)
Next
'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)
Next
Next
Next
''カーソル
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
' ファイルのフィルタを設定する
SaveFileDialog1.Filter = "Microsoft Office Excel ブック (*.xls)|*.xls;*.xlw|テキスト ファイル|*.txt;*.log|すべてのファイル|*.*"
' ファイルの種類 の初期設定を 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的值付的不正确.就会有
[このプログラムを使用してこの場所を開けません。 別の場所を試してください。]
这个问题.