- 日時： 2012/06/13 08:36
- 名前： VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー：[エクセル][][] *
* キーワード：VBA,Excel,Comオブジェクト,解放処理,起動,エクセル,終了,既存ファイル *
***********************************************************************************
'===================================================================================================
'投 稿 日：2012.05.05
'投 稿 者：VBレスキュー(花ちゃん)
'タイトル：VB2010 から Excel の起動・終了に関する設定色々
'========1=========2=========3=========4=========5=========6=========7=========8=========9=========0
動作確認：WindowsVista / Windows 7 / Excel 2007/2010 VB2010 / Framework 4 / ターゲットCPU：X86
[Option Compare Text] [Option Explicit On] [Option Infer On] [Option Strict On]で設定
プロジェクト→参照の追加→COM→Microsoft Excel 12.0(14.0) ObjectLibrary を参照設定しておいてください。
'---------------------------------------------------------------------------------------------------
'下記でエラーの波線が表示されたなら、プロジェクト→参照の追加→.NETタブ→から参照追加して下さい。
'下記の部分もバージョンに注意して下さい。(Excel 2007 〜用になっています。)
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Core
Imports System.Runtime.InteropServices
'Imports Microsoft.Vbe.Interop
Public Class Form1
#Region "Form1_Load 時の設定"
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'Form を右下の邪魔にならない位置に表示(お好みで設定して下さい)
Dim w As Integer = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Width
Dim h As Integer = System.Windows.Forms.Screen.PrimaryScreen.Bounds.Height
Me.Top = h - Me.Height - 35
Me.Left = w - Me.Width - 25
'メッセージボックス等がExcelの裏に隠れないようにする為に
Me.TopMost = True
End Sub
#End Region
#Region "Excel の起動・終了に関する設定"
'---------- Private な変数の宣言 -----------------------------------
Private xlApp As Excel.Application
Private xlBooks As Excel.Workbooks
Private xlBook As Excel.Workbook
Private xlSheets As Excel.Sheets
Private xlSheet As Excel.Worksheet
Private Sub ExcelOpen(ByVal FilePath As String, ByVal SheetName As String)
'Excel のオープン処理用プロシージャ
xlClose = False '起動中は、ユーザが Excel を閉じれないように
xlApp = New Excel.Application
'Excel の WorkbookBeforeClose イベントを取得
AddHandler xlApp.WorkbookBeforeClose, AddressOf xlApp_WorkbookBeforeClose
xlBooks = xlApp.Workbooks
If FilePath.Length = 0 Then
'新規のファイルを開く場合
xlBook = xlBooks.Add
xlSheets = xlBook.Worksheets
xlSheet = DirectCast(xlSheets.Item(1), Excel.Worksheet)
Else
'既存のファイルを開く場合
xlBook = xlBooks.Open(FilePath)
xlSheets = xlBook.Worksheets
xlSheet = DirectCast(xlSheets(SheetName), Excel.Worksheet)
End If
xlApp.Visible = True
End Sub
Private xlClose As Boolean 'ユーザが Excel を閉じようとしたかのフラグ
Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Excel.Workbook, ByRef Cancel As Boolean)
'VB2010 から Excel の WorkbookBeforeClose イベントを監視してユーザが Excel を閉じれないようにする
If xlClose = False Then
Cancel = True 'ユーザが Excel を閉じれないように
Else
Cancel = False 'プログラム上から指定の場合は、閉じる
End If
End Sub
Private Sub ExcelClose(ByVal FilePath As String, Optional ByVal CancelSave As Boolean = True)
'Excelファイルを上書き保存して終了処理用プロシージャ
xlClose = True 'プログラムからExcel を閉じた時のフラグ
xlApp.DisplayAlerts = False '保存時の問合せのダイアログを非表示に設定
If CancelSave Then
Dim kts As String = System.IO.Path.GetExtension(FilePath).ToLower()
Dim fm As Excel.XlFileFormat
'拡張子に合せて保存形式を変更(使用する Excel のバージョンに注意)
Select Case kts
Case ".csv" 'CSV (カンマ区切り) 形式
fm = Excel.XlFileFormat.xlCSV
Case ".xls" 'Excel 97〜2003 ブック形式
fm = Excel.XlFileFormat.xlExcel8
Case ".xlsx" 'Excel 2007〜ブック形式
fm = Excel.XlFileFormat.xlOpenXMLWorkbook
Case ".xlsm" 'Excel 2007〜マクロ有効ブック形式
fm = Excel.XlFileFormat.xlOpenXMLWorkbookMacroEnabled
Case Else '必要なものは、追加して下さい。
fm = Excel.XlFileFormat.xlWorkbookDefault
MessageBox.Show("ファイルの保存形式を確認して下さい。")
End Select
Try
xlBook.SaveAs(Filename:=FilePath, FileFormat:=fm) 'ファイルに保存
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End If
MRComObject(xlSheet) 'xlSheet の解放
MRComObject(xlSheets) 'xlSheets の解放
xlBook.Close() 'xlBook を閉じる
MRComObject(xlBook) 'xlBook の解放
MRComObject(xlBooks) 'xlBooks の解放
xlApp.Quit() 'Excelを閉じる
MRComObject(xlApp) 'xlApp を解放
End Sub
Private Sub ProcessCheck()
'タスクマネージャに、Excel.exe が残っていないか確認(テスト環境でのみ使用の事)
Dim st As Integer = System.Environment.TickCount
'以前は、Loop しながら5秒間程繰り返し確認していたのだが、その間に解放される場合が
'ある事が判明したので、下記のように1回きりの確認でもデクリメント処理がキチンと
'行われていたら解放される事が解ったので下記のように厳密に判定する事にしました。
System.Threading.Thread.Sleep(500)
Application.DoEvents()
If Process.GetProcessesByName("Excel").Length = 0 Then
'先にフォームを閉じるとエラーが発生するので
'必要により表示するなりコメントにして下さい。
MessageBox.Show(Me, "Excel.EXE は解放されました。")
Exit Sub
End If
If Process.GetProcessesByName("Excel").Length >= 1 Then
Dim ret As DialogResult
ret = MessageBox.Show(Me, "まだ Excel.EXE が起動しています。強制終了しますか？", _
"確認", MessageBoxButtons.YesNo)
If ret = Windows.Forms.DialogResult.Yes Then
Dim localByName As Process() = Process.GetProcessesByName("Excel")
Dim p As Process
'起動中のExcelを取得
For Each p In localByName
'Windou の無い(表示していない)Excel があれば強制終了させる
'画面に表示している Excel は、終了させないので必要なら手動で終了して下さい。
If System.String.Compare(p.MainWindowTitle, "", True) = 0 Then
'Excel.EXE のプロセスを削除
p.Kill()
End If
Next
End If
End If
End Sub
Public Sub MRComObject(Of T As Class)(ByRef objCom As T, Optional ByVal force As Boolean = False)
Dim IDEEnvironment As Boolean = False 'メッセージボックスを表示させたい場合は、True に設定
If objCom Is Nothing Then
If IDEEnvironment = True Then
'テスト環境の場合は下記を実施し、後は、コメントにしておいて下さい。
MessageBox.Show(Me, "Nothing です。")
End If
Return
End If
Try
If System.Runtime.InteropServices.Marshal.IsComObject(objCom) Then
Dim count As Integer
If force Then
count = System.Runtime.InteropServices.Marshal.FinalReleaseComObject(objCom)
Else
count = System.Runtime.InteropServices.Marshal.ReleaseComObject(objCom)
End If
If IDEEnvironment = True AndAlso count <> 0 Then
Try
'テスト環境の場合は下記を実施し、後は、コメントにしておいて下さい。
MessageBox.Show(Me, TypeName(objCom) & " 要調査！ デクリメントされていません。")
Catch ex As Exception
MessageBox.Show(Me, " 要調査！ デクリメントされていません。")
End Try
End If
Else
If IDEEnvironment = True Then
'テスト環境の場合は下記を実施し、後は、コメントにしておいて下さい。
MessageBox.Show(Me, "ComObject ではありませんので、解放処理の必要はありません。")
End If
End If
Finally
objCom = Nothing
End Try
End Sub
#End Region
End Class
|
Excel の起動・終了に関する設定(VB.NET)