「紙」への印刷はもちろん、最初から「Excel出力」を実装させることは多いと思います。
一旦、MDBに戻って、一覧のExcel出力を実装します。
前項「データベース接続を行なう。」の「トランザクション処理を使ってみます。」のサンプルを元に機能を追加してみました。
一覧表示画面の段階でメニューに「Excel出力」が追加されています。これにより画面の選択条件でExcelに一覧が出力されます。
メニューで選択条件を変更できるように「部署選択」のメニューコンボも追加してみました。但し、このExcel出力はデータベースから再抽出する方法なので、画面上の一覧の並び順には従いません。
メニューから「Excel出力」を選択すると、新規インスタンス(新規にExcelを起動)か既存インスタンス(開いているExcelに出力)かの指定ダイアログが表示されます。 Excelはもちろんウィンドウを持つアプリケーションなのですが、プログラムからの取り扱いは「プロセス」です。 プログラムからの出力動作とユーザーがウィンドウで操作する状態がバッティングして処理例外が起きることがあることは避けられませんが、 これをできるだけ避けるためには「新規インスタンス(新規にExcelを起動)」をお勧めするのでデフォルトとしていますが、 処理後に事前に開いている別ワークブックへすぐにコピー／貼り付け等を行なうような用途では操作に注意の上で「既存インスタンス(開いているExcelに出力)」も選択できるようにあります。
このダイアログはメッセージボックスと似ていますが、独自に共通利用できるように作成したもので、オーナーウィンドウを中央に表示されます。 システムのメッセージボックスはスクリーン中央への表示になるので小さいウィンドウのアプリケーションをスクリーンの隅に配置している時は不便なので作成したもので、 メッセージ表示テキストを右クリックからコピーする機能も持たせてあります。
一覧表示画面の段階でメニューに「Excel出力」が追加されています。これにより画面の選択条件でExcelに一覧が出力されます。
メニューで選択条件を変更できるように「部署選択」のメニューコンボも追加してみました。但し、このExcel出力はデータベースから再抽出する方法なので、画面上の一覧の並び順には従いません。
メニューから「Excel出力」を選択すると、新規インスタンス(新規にExcelを起動)か既存インスタンス(開いているExcelに出力)かの指定ダイアログが表示されます。 Excelはもちろんウィンドウを持つアプリケーションなのですが、プログラムからの取り扱いは「プロセス」です。 プログラムからの出力動作とユーザーがウィンドウで操作する状態がバッティングして処理例外が起きることがあることは避けられませんが、 これをできるだけ避けるためには「新規インスタンス(新規にExcelを起動)」をお勧めするのでデフォルトとしていますが、 処理後に事前に開いている別ワークブックへすぐにコピー／貼り付け等を行なうような用途では操作に注意の上で「既存インスタンス(開いているExcelに出力)」も選択できるようにあります。
このダイアログはメッセージボックスと似ていますが、独自に共通利用できるように作成したもので、オーナーウィンドウを中央に表示されます。 システムのメッセージボックスはスクリーン中央への表示になるので小さいウィンドウのアプリケーションをスクリーンの隅に配置している時は不便なので作成したもので、 メッセージ表示テキストを右クリックからコピーする機能も持たせてあります。
「参照設定」のままで配布してはいけません。
参照設定での実行ファイルは開発側と実行側でOfficeのバージョンが合っている必要があります。
特に実行側のOfficeのバージョンが開発側より低い場合は動作できないことが判っています。 開発そのものは「参照設定」で行なう方が簡単なので手慣れていない場合はこのページの方法をおすすめしますが、配布目的であれば最終的には次ページの「問題なければ「実行時バインド」に移してみます」で 「実行時バインド版」に変換して下さい。
特に実行側のOfficeのバージョンが開発側より低い場合は動作できないことが判っています。 開発そのものは「参照設定」で行なう方が簡単なので手慣れていない場合はこのページの方法をおすすめしますが、配布目的であれば最終的には次ページの「問題なければ「実行時バインド」に移してみます」で 「実行時バインド版」に変換して下さい。
- まずは実行状態の紹介です。
-
(画像をクリックすると、このサンプルがダウンロードできます)
このようにメニューに「Excel出力」が追加されています。
これをクリックすると、
このようにインスタンス指定のダイアログが表示されます。
「新規インスタンス(新規にExcelを起動)」はExcelが開いていても、そのExcelは使わずに新規にExcelアプリケーションを起動するというモードで、「既存インスタンス(開いているExcelに出力)」は新規にExcelアプリケーションを起動しません。
このようなアプリケーションからのExcelの利用は「プロセス」としての利用なので、Excelのようなウィンドウを持つアプリケーションの「プロセス」利用はユーザーのウィンドウ側の操作とバッティングして例外を起こす可能性があるわけで、必ず安全に正常終了するとは限りません。
無応答や応答拒否といった処理例外はユーザー操作との兼ね合いで発生しうるわけですが、「新規インスタンス(新規にExcelを起動)」の方が危険率は低いと言えます。
事前にExcelが起動されていなければどちらを選んでも同じ結果になります。
これがExcelに出力した状態です。 プロジェクトのルートフォルダにある「ExcelTemplate」フォルダにテンプレートがあり、これを起動して一覧と同じ条件でデータベースから抽出した内容を貼り付けます。 再抽出なので元の出力順に戻り、一覧画面の操作で並べ替えた条件は反映しませんが、メニューの部署選択の絞り込みは同様に反映して抽出されます。
これが部署選択メニューコンボを操作しているところです。
- 最初の開発時点では、「参照の追加」を行なう方が良いでしょう。
-
Excelをプログラムからハンドリングする時に参照設定にするのか、実行時バインドにするのかはいろいろと意見が別れるところだと思います。
すでにExcel2003以前はサポート切れとなり、ここで作成するアプリケーションからも対応除外しているので、 利用するExcelの可能バージョン範囲を意識するために実行時バインドにすることは念頭に置く必要が薄れたかも知れません。
このページで紹介するソースコードはこの「参照設定」が行なわれている状態のものです。
まずは一覧表示フォームのコードです。
機能としては「部署選択」のメニューコンボと「Excel出力」のメニューボタンの追加での記述が追加されています。'*************************************************************************************************** ' 配属一覧サンプル④(一覧表示) frmGetMdbDataTest04(Form) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' 変更日付 Rev 変更履歴内容--------------------------------------------------------------------> ' 17/01/15(1.0.0.0)新規作成 ' 17/01/22(1.0.1.0)更新登録画面追加に伴う修正 ' 17/01/29(1.0.2.0)ダブルクリック抑制処置の共通クラス化対応 ' 17/02/05(1.0.3.0)新規登録時は追加された行へスクロール位置を調整する対応 ' 17/02/26(1.0.4.0)配属一覧サンプル③からの転用でExcel出力機能を追加する対応 ' 17/04/02(1.0.5.0)部署メニューコンボ、Excelのインスタンス(新規・既存)指定機能を追加 ' 18/05/07(1.0.6.0)DataGridViewのスクロールバー表示不正の対応、初期処理をNewに移動させる対応 '*************************************************************************************************** Imports System.IO Public Class frmGetMdbDataTest04 '=============================================================================================== Private Const g_cnsTitle As String = "配属一覧サンプル④" Private Const g_cnsDGVColumnMAX As Integer = 5 ' DataGridView最大カラム(表示) '----------------------------------------------------------------------------------------------- ' 背景色 Private ReadOnly g_colorRetire As Color = Color.FromArgb(220, 220, 220) ' 退職色(薄灰) '----------------------------------------------------------------------------------------------- ' 共通クラス Private g_objAboutMDB As clsAboutMDB3 ' データベースI/Oクラス(MDB用) Private g_objAboutWindow As clsAboutWindow1 ' ウィンドウ制御関連クラス Private g_objAboutDGV As clsAboutDataGridView3 ' DataGridView制御関連クラス Private g_objOmitDoubleClick As clsOmitDoubleClick2 ' ダブルクリック抑制クラス ' 詳細登録フォーム Private g_objSYOUSAI_Form As dlgGetMdbDataTest03 = Nothing ' 詳細登録フォーム '----------------------------------------------------------------------------------------------- ' 一覧表示用抽出SQL文共通部 Private g_strSQL_Base As String = "" ' 抽出SQL文共通部 ' 現在一覧表示中の抽出SQL文退避 Private g_strSQL_Save As String = "" ' 抽出SQL文退避 '----------------------------------------------------------------------------------------------- ' デフォルトのカラム幅 Private g_tblDefaultColumnWidth() As Integer ' カラム幅テーブル '----------------------------------------------------------------------------------------------- ' 部署メニューコンボに対する部署コードテーブル Private g_tblBusyoCd() As String ' 部署コードテーブル '*********************************************************************************************** ' ■■■ 初期化 ■■■ '*********************************************************************************************** '* 処理名 ：New '* 機能 ：初期化 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2018年05月07日 '* 作成者 ：井上 治 '* 更新日 ：2018年05月07日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Public Sub New() '------------------------------------------------------------------------------------------- ' ※Windowsフォームデザイナ初期化(必須) Call InitializeComponent() ' フォームデザイナモード時は以下をスキップする If Me.DesignMode Then Exit Sub '------------------------------------------------------------------------------------------- ' データベースI/Oクラスの初期化 g_objAboutMDB = New clsAboutMDB3(Me, g_cnsMdbFileame, g_cnsMdbSubFolder) ' ウィンドウ制御関連クラスの初期化 g_objAboutWindow = New clsAboutWindow1(Me) ' ダブルクリック抑制クラスの初期化 g_objOmitDoubleClick = New clsOmitDoubleClick2(Me) ' DataGridView制御関連クラスの初期化 g_objAboutDGV = New clsAboutDataGridView3 '------------------------------------------------------------------------------------------- ' DataGridView(登録一覧)のカラム設定 Dim tblColInfo() As g_typDGVColInfo = Nothing With g_objAboutDGV Call .SetColumnInfo(tblColInfo, "社員CD", 50, g_cnsDG_MC) ' (00)社員コード Call .SetColumnInfo(tblColInfo, "氏名", 100, , _ g_cnsSM_Programmatic) ' (01)氏名 Call .SetColumnInfo(tblColInfo, "部署名", 150, , _ g_cnsSM_Programmatic) ' (02)部署名 Call .SetColumnInfo(tblColInfo, "役職名", 100, , _ g_cnsSM_Programmatic) ' (03)役職名 Call .SetColumnInfo(tblColInfo, "入社日", 90, g_cnsDG_MC) ' (04)入社日 Call .SetColumnInfo(tblColInfo, "退職日", 90, g_cnsDG_MC) ' (05)退職日 Call .SetColumnInfo(tblColInfo, "部署CD", 60, g_cnsDG_MC) ' (06)部署コード(非表示) Call .SetColumnInfo(tblColInfo, "役職CD", 50, g_cnsDG_MC) ' (07)役職コード(非表示) Call .SetColumnInfo(tblColInfo, "カナ氏名", 150) ' (08)カナ氏名(非表示) Call .SetColumnInfo(tblColInfo, "開始日", 90, g_cnsDG_MC) ' (09)配属開始日 ' 初期カラム幅設定を退避 g_tblDefaultColumnWidth = .GetDefaultColumnWidth(tblColInfo) ' 列幅を設定退避値で置き換える Call .AdjustColumnWidth(tblColInfo, My.Settings.ICHIRAN_COL_Width) '--------------------------------------------------------------------------------------- ' DataGridViewの初期設定(一般一覧用) Call .InitDataGridView1(DGV_ICHIRAN, tblColInfo, 1) '--------------------------------------------------------------------------------------- ' 半角英数列のフォントをMSゴシック10Pに変更 Dim objFont10 As Font = New Font(g_cnsStdFontName, g_cnsFontSize975) ' 英数項目用 ' DataGridViewのその他調整 With DGV_ICHIRAN ' プログラムSORT列指定 .Columns(1).Tag = 8 ' 氏名⇒カナ氏名 .Columns(2).Tag = 6 ' 部署名⇒部署コード .Columns(3).Tag = 7 ' 役職名⇒役職コード ' コード、日付列は当幅フォントに変更 .Columns(0).DefaultCellStyle.Font = objFont10 .Columns(4).DefaultCellStyle.Font = objFont10 .Columns(5).DefaultCellStyle.Font = objFont10 .Columns(6).DefaultCellStyle.Font = objFont10 .Columns(7).DefaultCellStyle.Font = objFont10 .Columns(9).DefaultCellStyle.Font = objFont10 ' 部署コード以降は非表示 .Columns(6).Visible = False .Columns(7).Visible = False .Columns(8).Visible = False .Columns(9).Visible = False End With '--------------------------------------------------------------------------------------- ' 列配置を設定退避値で置き換える Call .AdjustDGVColumnDisplayIndex(DGV_ICHIRAN, My.Settings.ICHIRAN_DisplayIndex) End With '------------------------------------------------------------------------------------------- ' 一覧表示用抽出SQL文共通部の編集(WHERE句の前まで) g_strSQL_Base = "SELECT H.[SCD]" ' (00)社員コード g_strSQL_Base &= ",S.[KANJI_SEI]+S.[KANJI_MEI]" ' (01)氏名(漢字) g_strSQL_Base &= ",B.[BUSYO_NM]" ' (02)部署名 g_strSQL_Base &= ",Y.[YAKU_NM]" ' (03)役職名 g_strSQL_Base &= ",S.[NYUSYA_YMD]" ' (04)入社日 g_strSQL_Base &= ",S.[TAISYOKU_YMD]" ' (05)退職日 g_strSQL_Base &= ",H.[BUSYO_CD]" ' (06)部署コード g_strSQL_Base &= ",H.[YAKU_CD]" ' (07)役職コード g_strSQL_Base &= ",S.[KANA_SEI]+S.[KANA_MEI]" ' (08)氏名(カナ) g_strSQL_Base &= ",H.[KAISHI_YMD]" ' (09)配属開始日 g_strSQL_Base &= " FROM (((" & g_cnsMST_HAIZOKU & " AS H" g_strSQL_Base &= g_cnsIN_JOIN & g_cnsMST_SYAIN & " AS S ON H.[SCD]=S.[SCD])" g_strSQL_Base &= g_cnsOUT_JOIN & g_cnsMST_BUSYO & " AS B ON H.[BUSYO_CD]=B.[BUSYO_CD])" g_strSQL_Base &= g_cnsOUT_JOIN & g_cnsMST_YAKU & " AS Y ON H.[YAKU_CD]=Y.[YAKU_CD])" End Sub '*********************************************************************************************** ' ■■■ フォームイベント ■■■ '*********************************************************************************************** '* 処理名 ：Form_FormClosed '* 機能 ：フォーム消失(FormClosed) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月15日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_FormClosed(ByVal sender As Object, _ ByVal e As FormClosedEventArgs) Handles Me.FormClosed '------------------------------------------------------------------------------------------- ' DataGridViewの列幅、列配置等を退避 With My.Settings .ICHIRAN_COL_Width = g_objAboutDGV.GetDGVColumnWidth(DGV_ICHIRAN) .ICHIRAN_DisplayIndex = g_objAboutDGV.GetDGVColumnDisplayIndex(DGV_ICHIRAN) Call g_objAboutWindow.FormSaveSettings1(.ICHIRAN_FormLocation, _ .ICHIRAN_FormSize, _ .ICHIRAN_WindowState) ' 設定を保存 .Save() End With '------------------------------------------------------------------------------------------- ' DataGridViewのColumnHeaderMouseClickイベントハンドラ解放(共通記述) RemoveHandler DGV_ICHIRAN.ColumnHeaderMouseClick, _ AddressOf g_objAboutDGV.DGV_ColumnHeaderMouseClick End Sub '*********************************************************************************************** '* 処理名 ：Form_Load '* 機能 ：フォーム初期化(Load) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月15日 '* 作成者 ：井上 治 '* 更新日 ：2018年05月07日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load '------------------------------------------------------------------------------------------- ' 一旦、メニューを消去 MNU_NEW.Visible = False MNU_EXCEL.Visible = False '------------------------------------------------------------------------------------------- ' フォーム位置・サイズ制御 With My.Settings Call g_objAboutWindow.FormAdjustLocationSize1(.ICHIRAN_FormLocation, _ .ICHIRAN_FormSize, Me.Size) Me.WindowState = .ICHIRAN_WindowState End With '------------------------------------------------------------------------------------------- ' DataGridViewのColumnHeaderMouseClickイベントハンドラ追加(共通記述) AddHandler DGV_ICHIRAN.ColumnHeaderMouseClick, _ AddressOf g_objAboutDGV.DGV_ColumnHeaderMouseClick End Sub '*********************************************************************************************** '* 処理名 ：Form_Shown '* 機能 ：フォーム初期表示(Shown) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月15日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_Shown(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Shown '------------------------------------------------------------------------------------------- ' 初回起動か If g_objOmitDoubleClick.FirstShown Then ' メニューコンボ等の初期セット If Not FP_SetFormList() Then Me.Close() Exit Sub End If g_objOmitDoubleClick.FirstShown = False End If ' 一覧再更新表示 If Not FP_ListUpdate() Then Me.Close() Exit Sub End If '------------------------------------------------------------------------------------------- MNU_NEW.Visible = True ' 初期表示動作完了 g_objOmitDoubleClick.Shown = True End Sub '*********************************************************************************************** ' ■■■ コントロールイベント ■■■ '*********************************************************************************************** '* 処理名 ：DGV_ICHIRAN_KeyUp '* 機能 ：グリッド表示のキーイベント(KeyUp) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub DGV_ICHIRAN_KeyUp(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) _ Handles DGV_ICHIRAN.KeyUp '------------------------------------------------------------------------------------------- ' Ctrl+Cでコピーができないようにする。 If (e.Control AndAlso (e.KeyCode = Keys.C)) Then ' クリップボードをクリア Clipboard.Clear() End If End Sub '*********************************************************************************************** '* 処理名 ：DGV_ICHIRAN_CellClick '* 機能 ：グリッド表示のイベント(CellClick) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub DGV_ICHIRAN_CellClick(ByVal sender As Object, _ ByVal e As DataGridViewCellEventArgs) _ Handles DGV_ICHIRAN.CellClick '------------------------------------------------------------------------------------------- ' ダブルクリック等の多重操作を抑制 If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub '------------------------------------------------------------------------------------------- ' DataGridViewのセル選択 Dim intRow As Integer = e.RowIndex ' 行INDEX ' 選択行0件時はスキップ If ((intRow < 0) OrElse (DGV_ICHIRAN.SelectedRows.Count = 0)) Then Exit Sub ' 処理中判定スイッチ対応 g_objOmitDoubleClick.OmitDoubleClick = True '------------------------------------------------------------------------------------------- ' 詳細表示フォームを起動 Call GP_ShowEntryForm(intRow) End Sub '*********************************************************************************************** '* 処理名 ：DGV_ICHIRAN_KeyDown '* 機能 ：グリッド表示のイベント(KeyDown) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月29日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub DGV_ICHIRAN_KeyDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) _ Handles DGV_ICHIRAN.KeyDown '------------------------------------------------------------------------------------------- ' ダブルクリック等の多重操作を抑制 If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub '------------------------------------------------------------------------------------------- ' Enterキーでなければ処理なし If ((e.KeyCode <> Keys.Enter) OrElse e.Shift) Then Exit Sub ' 表示0件時はスキップ If DGV_ICHIRAN.SelectedCells.Count = 0 Then Exit Sub e.Handled = True ' Enterキーで下行に移動させない Dim intRow As Integer = DGV_ICHIRAN.SelectedCells.Item(0).RowIndex ' 行INDEX ' 行未選択でなければ処理なし If intRow < 0 Then Exit Sub ' 処理中判定スイッチ対応 g_objOmitDoubleClick.OmitDoubleClick = True '------------------------------------------------------------------------------------------- ' 詳細表示フォームを起動 Call GP_ShowEntryForm(intRow) End Sub '*********************************************************************************************** '* 処理名 ：DGV_ICHIRAN_Leave '* 機能 ：グリッド表示のフォーカスアウトイベント(Leave) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub DGV_ICHIRAN_Leave(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles DGV_ICHIRAN.Leave '------------------------------------------------------------------------------------------- DGV_ICHIRAN.CurrentCell = Nothing End Sub '*********************************************************************************************** '* 処理名 ：MNU_CBO_BUSYO_SelectedIndexChanged '* 機能 ：グリッド表示のフォーカスアウトイベント(Leave) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年04月02日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub MNU_CBO_BUSYO_SelectedIndexChanged(ByVal sender As Object, _ ByVal e As System.EventArgs) _ Handles MNU_CBO_BUSYO.SelectedIndexChanged '------------------------------------------------------------------------------------------- ' ダブルクリック等の多重操作を抑制 If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub '------------------------------------------------------------------------------------------- ' 一覧再更新表示 If Not FP_ListUpdate() Then Me.Close() Exit Sub End If End Sub '*********************************************************************************************** '* 処理名 ：MNU_EXCEL_Click '* 機能 ：｢Excel出力｣メニューイベント(Click) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub MNU_EXCEL_Click(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles MNU_EXCEL.Click '------------------------------------------------------------------------------------------- ' ダブルクリック等の多重操作を抑制 If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub ' 抽出SQL文が退避されていない場合は終了 If g_strSQL_Save.Length = 0 Then Exit Sub '------------------------------------------------------------------------------------------- ' 出力確認メッセージ Dim strMSG As String = _ "現在の範囲指定の配属一覧をExcelに出力します。" & _ ControlChars.CrLf & ControlChars.CrLf & "よろしいですね？" ' 拡張メッセージボックス(Excel出力用)を表示 Dim intMessageResult As DialogResult = _ MessageBox2.DialogShowEx(Me, _ strMSG, _ g_cnsExcelMessageGuide, _ g_tblExcelButtonText, _ g_cnsTitle, _ MessageBoxButtons.YesNoCancel, _ MessageBoxIcon.Information) ' Yes(新規INSTANCE)、No(既存INSTANCE)以外は終了 If ((intMessageResult <> Windows.Forms.DialogResult.Yes) AndAlso _ (intMessageResult <> Windows.Forms.DialogResult.No)) Then Exit Sub ' 処理中判定スイッチ対応 g_objOmitDoubleClick.OmitDoubleClick = True '------------------------------------------------------------------------------------------- ' Excel出力フォームを表示 Using objExcelForm As dlgOutputExcel1 = New dlgOutputExcel1 With objExcelForm .prpSQL = g_strSQL_Save ' 抽出SQL文 ' 新規インスタンスかどうかの指定 .prpNewInstance = intMessageResult = Windows.Forms.DialogResult.Yes ' 処理中フォーム表示 .ShowDialog(Me) End With End Using End Sub '*********************************************************************************************** '* 処理名 ：MNU_NEW_Click '* 機能 ：｢新規登録｣メニューイベント(Click) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月05日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月05日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub MNU_NEW_Click(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles MNU_NEW.Click '------------------------------------------------------------------------------------------- ' ダブルクリック等の多重操作を抑制 If g_objOmitDoubleClick.CheckDoubleClick() Then Exit Sub '------------------------------------------------------------------------------------------- ' 詳細表示フォームを起動 Call GP_ShowEntryForm(-1) End Sub '*********************************************************************************************** ' ■■■ サブ処理 ■■■ '*********************************************************************************************** '* 処理名 ：FP_ListUpdate '* 機能 ：一覧再更新表示 '----------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月15日 '* 作成者 ：井上 治 '* 更新日 ：2018年05月07日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Function FP_ListUpdate() As Boolean '------------------------------------------------------------------------------------------- With DGV_ICHIRAN ' 一旦一覧を消去 If .Rows.Count <> 0 Then .Rows.Clear() End With ' Excel出力メニューの非表示 MNU_EXCEL.Visible = False g_strSQL_Save = String.Empty '------------------------------------------------------------------------------------------- ' 配属情報の抽出 Dim dbTbl As DataTable = Nothing ' DataTable Dim strToday As String = FP_SQLDateSUB2(Today) ' 本日日付(編集) Dim strSQL As String = g_strSQL_Base ' SQL文 strSQL &= " WHERE S.[NYUSYA_YMD]<=" & strToday strSQL &= " AND (S.[TAISYOKU_YMD] IS NULL OR S.[TAISYOKU_YMD]>=" & strToday & g_cnsKO ' 部署メニューコンボの条件 If MNU_CBO_BUSYO.SelectedIndex >= 1 Then strSQL &= " AND H.[BUSYO_CD]='" & g_tblBusyoCd(MNU_CBO_BUSYO.SelectedIndex) & g_cnsSC End If strSQL &= " ORDER BY H.[BUSYO_CD],H.[YAKU_CD],H.[SCD];" ' DataTable取得 If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_HAIZOKU) Then Return False g_strSQL_Save = strSQL '------------------------------------------------------------------------------------------- Dim intIx As Integer = 0 ' テーブルINDEX With DGV_ICHIRAN ' スクロールバーを一旦、非表示にする .ScrollBars = ScrollBars.None ' DataGridViewを一旦、非表示にする .Visible = False ' SORTマークを部署の昇順に設定 .Columns(2).HeaderCell.SortGlyphDirection = g_cnsSO_Ascending ' 他のプログラムソート列のSortマーク解除 .Columns(1).HeaderCell.SortGlyphDirection = g_cnsSO_None .Columns(3).HeaderCell.SortGlyphDirection = g_cnsSO_None ' 前回の一覧をクリア If .Rows.Count <> 0 Then .Rows.Clear() ' DataTableの全件を繰り返す Do While intIx < dbTbl.Rows.Count ' 行を追加 .Rows.Add() ' 一覧再更新表示サブ(１行単位) Call GP_ListUpdateSub(intIx, dbTbl.Rows(intIx).ItemArray.Clone) ' 次へ intIx += 1 Loop ' DataGridViewを再表示にする .Visible = True ' スクロールバーを再表示する .ScrollBars = ScrollBars.Both ' Excel出力メニューの表示 MNU_EXCEL.Visible = .Rows.Count > 0 End With ' データテーブルをクリア dbTbl.Clear() dbTbl.Reset() Return True End Function '*********************************************************************************************** '* 処理名 ：GP_ShowEntryForm '* 機能 ：入力(参照)用フォーム表示 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = DataGridViewの行Index(Integer) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月05日 '* 更新者 ：井上 治 '* 機能説明：更新登録フォームを表示させる '* 注意事項： '*********************************************************************************************** Private Sub GP_ShowEntryForm(ByVal intRow As Integer) '------------------------------------------------------------------------------------------- Dim intUpdateMode As Integer = 1 ' 登録モード Dim strScd As String = String.Empty ' 社員コード ' 行選択時は更新モードで動作 If intRow >= 0 Then intUpdateMode = 2 strScd = DGV_ICHIRAN.Rows(intRow).Cells(0).Value End If '------------------------------------------------------------------------------------------- ' 詳細登録フォームを起動 If g_objSYOUSAI_Form Is Nothing Then g_objSYOUSAI_Form = New dlgGetMdbDataTest03(g_objAboutMDB) End If With g_objSYOUSAI_Form .prpUpdateMode = intUpdateMode .prpScd = strScd ' 詳細画面を起動(モーダル) .ShowDialog(Me) ' 処理中判定スイッチ対応 g_objOmitDoubleClick.OmitDoubleClick = True ' 更新が成功した場合、一覧再表示 If .prpUpdateResult <> 0 Then Call GP_ListUpdate2(intRow, .prpScd, .prpNyusyaYmd) End If End With End Sub '*********************************************************************************************** '* 処理名 ：GP_ListUpdate2 '* 機能 ：一覧再更新表示(1行単位) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 更新行Index(Integer) ※新規登録時は-1 '* Arg2 = 社員コード(String) '* Arg3 = 配属開始日(Date) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月05日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub GP_ListUpdate2(ByVal intRow As Integer, _ ByVal strScd As String, _ ByVal dteKaishiYmd As Date) '------------------------------------------------------------------------------------------- ' 配属の読み込み Dim dbTbl As DataTable = Nothing ' DataTable Dim strSQL As String = g_strSQL_Base ' SQL文 strSQL &= " WHERE H.[SCD]='" & strScd & g_cnsSC strSQL &= " AND H.[KAISHI_YMD]=" & FP_SQLDateSUB2(dteKaishiYmd) & g_cnsCOL ' DataTable取得 If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_HAIZOKU) Then Me.Close() Exit Sub End If '------------------------------------------------------------------------------------------- Dim blnNewRow As Boolean = False ' 新規登録判定 ' 追加モード時はDataGridViewに行を追加 If intRow < 0 Then blnNewRow = True With DGV_ICHIRAN intRow = .Rows.Count .Rows.Add() End With End If '------------------------------------------------------------------------------------------- ' 一覧再更新表示サブ(１行単位) Call GP_ListUpdateSub(intRow, dbTbl.Rows(0).ItemArray.Clone) ' 新規登録時はスクロール位置を調整 If blnNewRow Then Call g_objAboutDGV.ScrollToAddedRow(DGV_ICHIRAN, intRow) End If ' データテーブルをクリア dbTbl.Clear() dbTbl.Reset() End Sub '*********************************************************************************************** '* 処理名 ：GP_ListUpdateSub '* 機能 ：一覧再更新表示サブ(１行単位) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = 行INDEX(Integer) '* Arg2 = dbTbl.Rows(IX).ItemArray(Object) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年01月22日 '* 作成者 ：井上 治 '* 更新日 ：2017年01月22日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：FP_ListUpdateとGP_ListUpdate2から呼び出される '*********************************************************************************************** Private Sub GP_ListUpdateSub(ByRef intRow As Integer, _ ByRef objItemArray As Object()) '------------------------------------------------------------------------------------------- With DGV_ICHIRAN.Rows(intRow) .Cells(0).Value = objItemArray(0) ' (00)社員コード .Cells(1).Value = objItemArray(1) ' (01)氏名(漢字) ' 氏名(漢字)のToolTipに氏名(カナ)を設定 .Cells(1).ToolTipText = objItemArray(8) .Cells(2).Value = objItemArray(2) ' (02)部署名 .Cells(3).Value = objItemArray(3) ' (03)役職名 .Cells(4).Value = FP_EditDate(objItemArray(4)) ' (04)入社日 .Cells(5).Value = FP_EditDate(objItemArray(5)) ' (05)退職日 .Cells(6).Value = objItemArray(6) ' (06)部署コード .Cells(7).Value = objItemArray(7) ' (07)役職コード .Cells(8).Value = objItemArray(8) ' (08)氏名(カナ) .Cells(9).Value = FP_EditDate(objItemArray(9)) ' (09)配属開始日 ' 退職者か(退職日有り) If .Cells(5).Value.ToString.Length <> 0 Then ' 退職者はグレーで塗りつぶし For intCol As Integer = 0 To g_cnsDGVColumnMAX .Cells(intCol).Style.BackColor = g_colorRetire Next intCol End If End With End Sub '*********************************************************************************************** '* 処理名 ：FP_SetFormList '* 機能 ：メニューコンボ等の初期セット '----------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年04月02日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Function FP_SetFormList() As Boolean '------------------------------------------------------------------------------------------- ' 配属の読み込み Dim dbTbl As DataTable = Nothing ' DataTable Dim strSQL As String = "SELECT [BUSYO_CD]" ' (00)部署コード strSQL &= ",[BUSYO_NM]" ' (01)部署名 strSQL &= g_cnsFROM & g_cnsMST_BUSYO strSQL &= " ORDER BY [BUSYO_CD];" ' DataTable取得 If Not g_objAboutMDB.GetDataTableOle(dbTbl, strSQL, g_cnsMST_BUSYO) Then Return False End If Dim intIx As Integer = 0 ' テーブルINDEX Dim intIx2 As Integer = 0 ' テーブルINDEX Dim intIxMax As Integer = dbTbl.Rows.Count ' テーブルINDEX上限 Dim tblName() As String ' メニューコンボ表示名 ReDim tblName(intIxMax), g_tblBusyoCd(intIxMax) ' 先頭は「すべて」 tblName(0) = "(すべて)" g_tblBusyoCd(0) = String.Empty ' 部署マスタ内容を巡回 Do While intIx < intIxMax intIx2 += 1 g_tblBusyoCd(intIx2) = dbTbl.Rows(intIx)(0) tblName(intIx2) = dbTbl.Rows(intIx)(1) ' 次へ intIx += 1 Loop ' メニューコンボへの登録 With MNU_CBO_BUSYO With .Items If .Count <> 0 Then .Clear() .AddRange(tblName) End With .SelectedIndex = 0 End With Return True End Function '----------------------------------------<< End of Source >>------------------------------------ End Class
「部署選択」メニューコンボのリストは固定ではなく部署マスタから生成するのでForm_Shownイベントの一覧表示の前にFP_SetFormListが呼び出されてその中で行なっています。 FP_SetFormListでは「部署選択」メニューコンボのリストとこれに対応する部署コードテーブルを作成しており、部署コードテーブルは本フォームクラスのモジュールレベルに配置して再利用できるようにしています。
「部署選択」メニューコンボの選択イベント(MNU_CBO_BUSYO_SelectedIndexChanged)も追加しており、ここでは一覧表示(FP_ListUpdate)を単に呼び出します。
一覧表示(FP_ListUpdate)では抽出SQL文のWHERE句の編集で「部署選択」メニューコンボの選択インデックスによる 部署コードでの抽出条件を追加しており、これで「部署選択」メニューコンボ操作でその部署のリストに置き換わる動作になるわけです。
ここで編集した抽出SQL文は本フォームクラスのモジュールレベルに退避しており、Excel出力時にExcel出力フォームに引き渡されるという仕組みです。
次はExcel出力フォームのコードです。
このページの「主人公」なのですが、手前の一覧フォームのコードが長かったためかすんでしまった感があります。 しかも単純な一覧表示のExcel出力ではありますが、ソースコードもコンパクトだと思います。
これは、Excelを扱う上での共通記述に追いやれる部分を次で説明する「Excel関連共通クラス」に委譲したことと、 このページの最後に説明しているどうしても避けられない例外処置をクラス実装をしている「フォーム初期表示(Form_Shown)」の記述部分にまとめていることによります。
一覧画面からのメニュー起動ですが、一覧DataGridViewの表示内容からExcelシートを編集しているわけではなく、 再度データベースから読み直してExcelシートを編集します。'*************************************************************************************************** ' 配属一覧サンプル(Excel出力①：参照設定版) dlgOutputExcel1(Form) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' 変更日付 Rev 変更履歴内容--------------------------------------------------------------------> ' 17/02/26(1.0.4.0)新規作成 ' 17/03/01(1.0.4.0)作成途中⇒処理例外等を1箇所で処置するように対応中 ' 17/04/02(1.0.5.0)Excelのインスタンス(新規・既存)指定機能を追加、拡張メッセージボックスの対応 '*************************************************************************************************** Imports System.IO Imports Microsoft.Office.Interop Friend Class dlgOutputExcel1 '=============================================================================================== Private Const g_cnsTitle As String = "配属一覧サンプル(Excel出力①)" Private Const g_cnsTemplate As String = "ExcelSample1.xltx" Private Const g_cnsTempPath As String = "..\..\ExcelTemplate" Private Const g_cnsColMax As Integer = 5 '----------------------------------------------------------------------------------------------- ' 共通クラス Private g_objAboutMDB As clsAboutMDB3 ' データベースI/Oクラス(MDB用) '----------------------------------------------------------------------------------------------- ' フォーム間受け渡し変数 Private g_strSQL As String = String.Empty ' 抽出SQL文 Private g_blnNewInstance As Boolean = False ' 新規インスタンス指定 '*********************************************************************************************** ' ■■■ フォームイベント ■■■ '*********************************************************************************************** '* 処理名 ：Form_Load '* 機能 ：フォーム初期化(Load) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load '------------------------------------------------------------------------------------------- ' データベースI/Oクラスの初期化 g_objAboutMDB = New clsAboutMDB3(Me, g_cnsMdbFileame, g_cnsMdbSubFolder) End Sub '*********************************************************************************************** '* 処理名 ：Form_Shown '* 機能 ：フォーム表示完了(Shown) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_Shown(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles Me.Shown '------------------------------------------------------------------------------------------- Application.DoEvents() '------------------------------------------------------------------------------------------- Dim objWbk As Excel.Workbook = Nothing ' Excel.Workbook ' Excel出力クラスの初期化(Escキーのイベントはクラス側に実装済) Using clsExcel = New clsAboutExcel1(Me, True) '--------------------------------------------------------------------------------------- Dim strMSGHeader As String = String.Empty ' メッセージヘッダ Try '------------------------------------------- ' Excel出力(処理本体) Call GP_MakeExcelSheet(clsExcel, objWbk, strMSGHeader) Catch ex As Exception '------------------------------------------- ' 処理中例外メッセージの表示 Call clsExcel.ShowFatalMessage(g_cnsTitle, strMSGHeader, ex.Message) ' 例外時後始末(但しExcel応答無しなどではここでの対応は働かない！) Call clsExcel.SuspendExcelProc(objWbk) End Try '--------------------------------------------------------------------------------------- End Using '------------------------------------------------------------------------------------------- ' 閉じる Me.Close() End Sub '*********************************************************************************************** ' ■■■ サブ処理 ■■■ '*********************************************************************************************** '* 処理名 ：GP_MakeExcelSheet '* 機能 ：Excel出力(処理本体) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Excel出力クラス(Object) '* Arg2 = Excel.Workbook(Object) '* Arg3 = 例外時メッセージヘッダ(String) ※Ref参照 '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：本処理中の例外は上位でトラップされる(この処理内ではトラップしない) '*********************************************************************************************** Private Sub GP_MakeExcelSheet(ByRef clsExcel As clsAboutExcel1, _ ByRef objWbk As Excel.Workbook, _ ByRef strMSGHeader As String) '------------------------------------------------------------------------------------------- strMSGHeader = "データ抽出中" ' 配属情報の抽出 Dim dbTbl As DataTable = Nothing ' DataTable ' DataTable取得 If Not g_objAboutMDB.GetDataTableOle(dbTbl, g_strSQL, g_cnsMST_HAIZOKU) Then Exit Sub '------------------------------------------------------------------------------------------- Dim intCntRec As Integer = 0 ' レコードカウンタ Dim intIx As Integer = 0 ' テーブルINDEX Dim intIxMax As Integer = dbTbl.Rows.Count - 1 ' テーブルINDEX上限 Dim tblRec(intIxMax, g_cnsColMax) As Object ' 2次元配列テーブル PRB_SYORICHU.Maximum = intIxMax + 1 ' 全レコードを巡回 Do While intIx <= intIxMax intCntRec += 1 ' プログレスバーの処置 Call GP_SetProgressBarValue(PRB_SYORICHU, intCntRec) ' 2次元配列テーブルに配置 For intIx2 As Integer = 0 To g_cnsColMax tblRec(intIx, intIx2) = dbTbl.Rows(intIx)(intIx2) Next intIx2 ' 次へ intIx += 1 Loop ' データテーブルをクリア dbTbl.Clear() dbTbl.Reset() '------------------------------------------------------------------------------------------- strMSGHeader = "Excel起動中" Dim strFilename As String ' ファイル名 ' フルパステンプレート名(実行EXEの2階層上のExcelTemplateフォルダになっています) Dim objUri1 As New Uri(My.Application.Info.DirectoryPath) Dim objUri2 As New Uri(objUri1, g_cnsTempPath) strFilename = Path.Combine(objUri2.LocalPath, g_cnsTemplate) ' テンプレートOPEN If Not clsExcel.GetWorkbook(strFilename, _ objWbk, _ strMSGHeader, _ g_blnNewInstance) Then Exit Sub '------------------------------------------------------------------------------------------- strMSGHeader = "Excel出力中" ' ワークシートに貼り付け(矩形貼り付け) With objWbk.Worksheets(1) Dim intRow As Integer = intIxMax + 2 ' 行INDEX Dim intCol As Integer = g_cnsColMax + 1 ' カラムINDEX .Range(.Cells(2, 1), .Cells(intRow, intCol)).Value = tblRec End With '------------------------------------------------------------------------------------------- strMSGHeader = "終了処理" ' 終了(Excelを表示) Call clsExcel.SuspendExcelProc(objWbk, True) End Sub '*********************************************************************************************** ' ■■■ 受け渡しプロパティ ■■■ '*********************************************************************************************** ' 抽出SQL文(String) '----------------------------------------------------------------------------------------------- Friend WriteOnly Property prpSQL() As String Set(ByVal value As String) g_strSQL = value End Set End Property '=============================================================================================== ' 新規インスタンス指定(Boolean) '----------------------------------------------------------------------------------------------- Friend WriteOnly Property prpNewInstance() As Boolean Set(ByVal value As Boolean) g_blnNewInstance = value End Set End Property '----------------------------------------<< End of Source >>------------------------------------ End Class
従って並び順は最初に一覧表示された時点の並び順で、一覧表示後に何らかの変更が他クライアントから登録された場合についても最新の一覧がExcelシートに出力されます。
データベースからのデータをExcelシートに編集する方法ですが、セル単位にデータをセットする方法では処理速度があまりに遅いため、 いろいろ試した結果、セル範囲編集区画全体に一括してデータをセットできるように二次元配列テーブルをあらかじめ作成する方法を用いています。
セル範囲への転記は行数、列数を合わせたセル範囲を指定して1行の記述で転記します。 このサンプルは「Value」ですが、二次元配列テーブルの編集で行番号や横合計などの計算式を含めることもでき、この場合は「FormulaR1C1」でセットします。
冒頭の説明でも触れましたが、この「Excel出力(処理本体:GP_MakeExcelSheet)」では例外処理を記述していません。
呼び出し先の「Excel関連共通クラス」のプロシージャには例外処理を行なっているものはありますが、 この「Excel出力(処理本体:GP_MakeExcelSheet)」には例外処理の記述はなく、 この状態で例外が発生すると、呼び出し元の「フォーム初期表示(Form_Shown)」で記述しているエラートラップに捕まります。
「Excel出力(処理本体:GP_MakeExcelSheet)」内のどの工程で例外が起きたのかは Ref参照の引数「strMSGHeader」を経由してエラーメッセージが「○○でエラーが発生しました。」と表示されるようになっています。
但し、作成の初段階からこのように記述してしまうと、例外の発生箇所が判らなくなってしまうという問題があります。 変数「strMSGHeader」である程度は絞り込めますが、デバッグ段階では「Try～Catch」は外した方がでしょう。
このような時はデバッグモードとリリースモードを条件付きコンパイルで切り分けます。
「Excel関連共通クラス(clsAboutExcel1)」内は個別に例外処理を行なっていますが、 それ以外は全てこの「Form_Shown」の例外処理に集約されています。 配下の「Excel出力(処理本体)」だけでなく、その配下のサブ処理で発生する例外についても ここにトラップされるので、デバッグの初段階ではこのように「Try～Catch」を外して実行させるようにします。'*********************************************************************************************** '* 処理名 ：Form_Shown '* 機能 ：フォーム表示完了(Shown) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年03月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub Form_Shown(ByVal sender As Object, _ ByVal e As System.EventArgs) Handles Me.Shown '------------------------------------------------------------------------------------------- Application.DoEvents() '------------------------------------------------------------------------------------------- Dim objWbk As Excel.Workbook = Nothing ' Excel.Workbook ' Excel出力クラスの初期化(Escキーのイベントはクラス側に実装済) Using clsExcel = New clsAboutExcel1(Me, True) '--------------------------------------------------------------------------------------- Dim strMSGHeader As String = String.Empty ' メッセージヘッダ #If DEBUG Then '------------------------------------------- ' Excel出力(処理本体) Call GP_MakeExcelSheet(clsExcel, objWbk, strMSGHeader) #Else Try '------------------------------------------- ' Excel出力(処理本体) Call GP_MakeExcelSheet(clsExcel, objWbk, strMSGHeader) Catch ex As Exception '------------------------------------------- ' 処理中例外メッセージの表示 Call clsExcel.ShowFatalMessage(g_cnsTitle, strMSGHeader, ex.Message) ' 例外時後始末(但しExcel応答無しなどではここでの対応は働かない！) Call clsExcel.SuspendExcelProc(objWbk) End Try #End If '--------------------------------------------------------------------------------------- End Using '------------------------------------------------------------------------------------------- ' 閉じる Me.Close() End Sub
上記のExcel出力フォームのコード内では肝心のExcel操作に関する記述が共通関数の呼び出しだけになっています。 この共通関数等を配置しているのが「Excel関連共通クラス(clsAboutExcel1)」です。
これはクラスなのですが、先頭には関連定数などを配置したモジュール部を持っており、クラス側はUsing利用を実現するためDisposeを可能とする仕様にしてあります。'*************************************************************************************************** ' サンプル用Excel関連定数 modAboutExcel1(Module) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' [参照追加]・Microsoft Excel 1x.0 Object Library ' ※この下に「Excel関連クラス(clsAboutExcel1)」があります '*************************************************************************************************** ' 変更日付 Rev 変更履歴内容--------------------------------------------------------------------> ' 17/02/26(1.0.0.0)新規作成 ' 17/04/02(1.0.0.0)Excelの既存インスタンス指定機能の追加対応 ' 17/04/22(1.0.2.0)不要インポートの削除(System.Net、System.Runtime.InteropServices.ComTypes) '*************************************************************************************************** Imports System.IO Imports Microsoft.Office.Interop Imports System.Runtime.InteropServices Imports Microsoft.Win32.SafeHandles Module modAboutExcel1 '=============================================================================================== ' Excel処理関連定数 Friend Const g_cnsExcelApplication As String = "Excel.Application" Friend Const xlCalculationAutomatic As Int16 = -4105 Friend Const xlCalculationManual As Int16 = -4135 Friend Const xlSheetVisible As Int16 = -1 Friend Const xlSheetHidden As Int16 = 0 Friend Const xlSheetVeryHidden As Int16 = 2 Friend Const xlMaximized As Int16 = -4137 Friend Const xlMinimized As Int16 = -4140 Friend Const xlNormal As Int16 = -4143 '----------------------------------------------------------------------------------------------- ' 保存ファイル形式定数 Friend Const xlExcel8 As Int16 = 56 ' 旧xls形式 Friend Const xlTemplate8 As Int16 = 17 ' 旧xlt形式 Friend Const xlOpenXMLWorkbook As Int16 = 51 ' xlsx形式 Friend Const xlOpenXMLWorkbookMacroEnabled As Int16 = 52 ' xlsm形式 Friend Const xlOpenXMLTemplate As Int16 = 54 ' xltx形式 Friend Const xlOpenXMLTemplateMacroEnabled As Int16 = 53 ' xltm型式 Friend Const xlAddIn8 As Int16 = 18 ' xla型式 Friend Const xlOpenXMLAddIn As Int16 = 55 ' xlam型式 '----------------------------------------------------------------------------------------------- ' セル収容可能文字数(矩形転記時上限) Friend Const g_cnsCellStringLengthMax As Integer = 911 '----------------------------------------------------------------------------------------------- ' 拡張メッセージボックス用ガイド(Excel処理専用：参照系用) Friend ReadOnly g_tblExcelButtonText() As String = {"新規にExcelを起動して出力", _ "開いているExcelに出力", _ "キャンセル"} Friend ReadOnly g_cnsExcelMessageGuide As String = _ "新規にExcelを起動して出力するか、開いている(実行中)Excelに出力するかの指定です。" & _ ControlChars.CrLf & _ "｢開いているExcelに出力｣を選択してもExcelが起動していない場合は新規に起動して出力されます。" & _ ControlChars.CrLf & _ "※特に指定がない場合は｢新規にExcelを起動して出力｣を選択して下さい。" & ControlChars.CrLf & _ "※出力処理中はExcelを操作しないで下さい。" '----------------------------------------------------------------------------------------------- ' メッセージボックスコントロール(OwnerParent版) Friend MessageBox2 As New clsMessageBox2Ex '---------------------------------------<< End of Source >>------------------------------------- End Module '*************************************************************************************************** ' サンプル用Excel関連クラス(参照設定版) clsAboutExcel1(Class) ' ' 作成者:井上治 URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!] '*************************************************************************************************** ' 変更日付 Rev 変更履歴内容--------------------------------------------------------------------> ' 17/02/26(1.0.0.0)新規作成 ' 17/04/02(1.0.0.0)Excelの既存インスタンス指定機能の追加対応 ' 17/04/11(1.0.0.0)ブックOPEN時のイベント制御の不備を修正 '*************************************************************************************************** Friend Class clsAboutExcel1 Implements IDisposable '=============================================================================================== ' テンプレート形式拡張子 Private Const g_cnsXLT As String = ".XLT" ' 97-2003形式テンプレート Private Const g_cnsXLTM As String = ".XLTM" ' 2007形式テンプレート(マクロ有効) Private Const g_cnsXLTX As String = ".XLTX" ' 2007形式テンプレート(マクロ無効) '----------------------------------------------------------------------------------------------- ' Field to handle multiple calls to Dispose gracefully. Private g_blnDisposed As Boolean = False ' 破棄判定 ' SafeHandleインスタンス Private handle As SafeHandle = New SafeFileHandle(IntPtr.Zero, True) ' SafeHandleインスタンス '----------------------------------------------------------------------------------------------- ' Excel関連オブジェクト Private g_objExcel As Excel.Application = Nothing ' Excel.Application Private g_objWorkbooks As Excel.Workbooks = Nothing ' Excel.Workbooks '----------------------------------------------------------------------------------------------- ' MessageBoxのOwnerWindow指定のための現在フォーム Private g_objOwnerForm As Object = Nothing ' Ownerフォーム ' 各スイッチ Private g_swNewInstance As Boolean = False ' 新規インスタンス Private g_swPrintCancel As Boolean = False ' 処理中断スイッチ Private g_swExcelDuringProc As Boolean = False ' 出力処理中スイッチ Private g_blnUseKeyDown As Boolean = False ' KeyDownイベント使用 ' ブックOPEN時のイベント状態(イベント停止する場合はFP_GetWorkbookを呼ぶ前にFalseにする) Private g_swExcelEnableEvents As Boolean = True ' [初期値]True '*********************************************************************************************** ' ■■■ クラス初期化メソッド ■■■ '*********************************************************************************************** '* 処理名 ：New '* 機能 ：初期化 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Ownerフォーム(Object) '* Arg2 = KeyDownイベント使用(Boolean) ※Option '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：KeyDownイベント使用の時はフォームデザイナでKeyPreviewをTrueにして下さい '*********************************************************************************************** Friend Sub New(ByRef objOwner As Object, _ Optional ByVal blnUseKeyDown As Boolean = False) '------------------------------------------------------------------------------------------- g_objOwnerForm = objOwner ' Ownerフォーム g_blnUseKeyDown = blnUseKeyDown ' KeyDownイベント使用 g_swNewInstance = False g_swExcelEnableEvents = True g_swPrintCancel = False 'g_strFatalErrMSG = String.Empty ' KeyDownイベント使用 If g_blnUseKeyDown Then ' KeyDownイベントハンドラ追加 AddHandler CType(objOwner, Form).KeyDown, AddressOf Form_KeyDown End If End Sub '*********************************************************************************************** ' ■■■ 破棄 ■■■ '*********************************************************************************************** '* 処理名 ：Dispose、Finalize '* 機能 ：クラス破棄 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Overloads Sub Dispose() Implements IDisposable.Dispose '------------------------------------------------------------------------------------------- Dispose(True) GC.SuppressFinalize(Me) End Sub Protected Friend Overloads Sub Dispose(ByVal blnDisposing As Boolean) '------------------------------------------------------------------------------------------- ' 既に破棄されていないか If Not g_blnDisposed Then ' Dispose呼び出しか If blnDisposing Then handle.Dispose() g_blnDisposed = True End If If g_blnUseKeyDown Then ' KeyDownイベントハンドラ開放 RemoveHandler CType(g_objOwnerForm, Form).KeyDown, AddressOf Form_KeyDown End If ' 確保しているExcel関連全てオブジェクトの解放 Call GP_ReleaseAllExObject() ' 参照破棄 g_objOwnerForm = Nothing End If End Sub '*********************************************************************************************** ' ■■■ フォームイベント ■■■ '*********************************************************************************************** '* 処理名 ：Form_KeyDown '* 機能 ：キー押下イベント(Form_KeyDown) '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(デフォルト) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Sub Form_KeyDown(ByVal sender As Object, _ ByVal e As System.Windows.Forms.KeyEventArgs) '------------------------------------------------------------------------------------------- ' Escキーは中断指示とみなす If ((e.KeyCode = Keys.Escape) AndAlso (Not e.Shift)) Then ' 処理中断スイッチをセット g_swPrintCancel = True End If End Sub '*********************************************************************************************** ' ■■■ 公開メソッド ■■■ '*********************************************************************************************** '* 処理名 ：GetWorkbook '* 機能 ：Excelのインスタンスを生成してワークブックを開く '----------------------------------------------------------------------------------------------- '* 返り値 ：処理正否(Boolean) '* 引数 ：Arg1 = ワークブックファイル名(String) ※フルパスで指定 '* Arg2 = Excel.Workbook(Object) ※Ref参照 '* Arg3 = 例外時メッセージヘッダ(String) ※Ref参照 '* Arg4 = 新規インスタンス指定(Boolean) '* Arg5 = 引数UpdateLinks(Int16) ※Option:Workbook時の引数 '* Arg6 = 引数ReadOnly(Boolean) ※Option:Workbook時の引数 '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：ファイル名ブランク時は新規ブックを返す '*********************************************************************************************** Friend Function GetWorkbook(ByVal strFileName As String, _ ByRef objWBK As Excel.Workbook, _ ByRef strMSGHeader As String, _ ByVal blnNewInstance As Boolean, _ Optional ByVal intUpdateLinks As Int16 = 0, _ Optional ByVal blnReadOnly As Boolean = True) As Boolean '------------------------------------------------------------------------------------------- Dim blnTemplate As Boolean = False ' テンプレート判定 Dim strBooknameU As String = String.Empty ' ブック名(大文字変換) g_swNewInstance = False GetWorkbook = False objWBK = Nothing '------------------------------------------------------------------------------------------- ' ファイル名の指定があるか If strFileName.Length <> 0 Then ' ファイル存在確認 If Not FP_CheckExistsFile(strFileName, _ blnTemplate, _ strBooknameU, _ strMSGHeader) Then Return False End If '------------------------------------------------------------------------------------------- ' Excel.Applicationのインスタンス生成 strMSGHeader = "Excel.Applicationのインスタンス生成" ' 新規インスタンス指定か If blnNewInstance Then ' 新規インスタンス指定 g_objExcel = New Excel.Application Else ' Excel.Applicationのタイプ取得(未インストールの場合は例外発生) Dim typType As Type = Type.GetTypeFromProgID(g_cnsExcelApplication) ' Type Try ' Excelが実行中の場合は実行中のインスタンスを取得 ' ここで'System.Exception'の初回例外が発生しますがTry捕捉内なので無視します g_objExcel = GetObject(, g_cnsExcelApplication) Catch ex As Exception ' Excelが実行中でない(又は取得失敗)場合は新規にインスタンスを生成 g_objExcel = Activator.CreateInstance(typType) End Try End If '------------------------------------------------------------------------------------------- ' Excel.Workbooksの取得 strMSGHeader = "Excel.Workbooksの取得" g_objWorkbooks = g_objExcel.Workbooks '------------------------------------------------------------------------------------------- ' ワークブックの指定がない場合は新規ブックを返す If strFileName.Length = 0 Then ' 新規ワークブックを開く Return FP_OpenNewWorkbook(objWBK, strMSGHeader) Else ' 既存のワークブックを開く Return FP_OpenExiWorkbook(strFileName, _ blnTemplate, _ strBooknameU, _ intUpdateLinks, _ blnReadOnly, _ objWBK, _ strMSGHeader) End If End Function '*********************************************************************************************** '* 処理名 ：SuspendExcelProc '* 機能 ：Excel出力の終了 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = Excel.Workbook(Object) ※Option '* Arg2 = 終了回避スイッチ(Boolean) ※Option:True=Excel終了しない '* Arg3 = 保存済回避スイッチ(Boolean) ※Option:True=保存済にしない '* Arg4 = COMオブジェクト解放スイッチ(Boolean) ※Option:True=解放する '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年03月01日 '* 作成者 ：井上 治 '* 更新日 ：2017年03月01日 '* 更新者 ：井上 治 '* 機能説明：WorkbookのCloseやExcelの終了を含む(Excelを表示させて終了も可) '* 注意事項：この処理中での例外は無視される '*********************************************************************************************** Friend Sub SuspendExcelProc(Optional ByRef objWbk As Excel.Workbook = Nothing, _ Optional ByVal blnOmitQuit As Boolean = False, _ Optional ByVal blnOmitSaved As Boolean = False, _ Optional ByVal blnReleaseComObject As Boolean = True) '------------------------------------------------------------------------------------------- ' 閉じない指定でなければブックを閉じる If objWbk IsNot Nothing AndAlso Not blnOmitQuit AndAlso blnReleaseComObject Then Try Call StartScreenUpdate() objWbk.Saved = True ' 展開ブックは保存済み属性とする objWbk.Close(False) Finally ' COMオブジェクト解放 Call GP_ReleaseComObject(objWbk) End Try End If '------------------------------------------------------------------------------------------- ' Workbooks解放 If g_objWorkbooks IsNot Nothing Then Try ' 別のワークブックが存在するか blnOmitQuit = g_objWorkbooks.Count <> 0 ' COMオブジェクト解放 Call GP_ReleaseComObject(g_objWorkbooks) Finally ' 無視 End Try End If '------------------------------------------------------------------------------------------- Try ' Application解放 If Not blnOmitQuit AndAlso blnReleaseComObject Then ' Excelの終了 g_objExcel.Quit() Application.DoEvents() Else ' Excelの現状復帰(表示再開等) g_objExcel.Visible = True ' Excelウィンドウを表示 If g_objExcel.WindowState = xlMinimized Then ' 最小化状態だったら通常に復帰 g_objExcel.WindowState = xlNormal End If Call StartScreenUpdate() If ((Not objWbk Is Nothing) AndAlso (Not blnOmitSaved)) Then objWbk.Saved = True ' 展開ブックは保存済み属性とする End If End If Finally ' COMオブジェクト解放 If Not blnOmitQuit AndAlso blnReleaseComObject Then Call GP_ReleaseComObject(g_objExcel) End If End Try End Sub '*********************************************************************************************** '* 処理名 ：StopScreenUpdate '* 機能 ：Excelの画面描画停止 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年03月01日 '* 作成者 ：井上 治 '* 更新日 ：2017年03月01日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Sub StopScreenUpdate() '------------------------------------------------------------------------------------------- With g_objExcel .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With End Sub '*********************************************************************************************** '* 処理名 ：StartScreenUpdate '* 機能 ：Excelの画面描画再開 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年03月01日 '* 作成者 ：井上 治 '* 更新日 ：2017年03月01日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Sub StartScreenUpdate() '------------------------------------------------------------------------------------------- With g_objExcel .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End Sub '*********************************************************************************************** '* 処理名 ：ReleaseComObject '* 機能 ：COMオブジェクトの解放 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = COMオブジェクト(Object) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Sub ReleaseComObject(ByRef objCOM As Object) '------------------------------------------------------------------------------------------- ' COMオブジェクトの解放(共通処理) Call GP_ReleaseComObject(objCOM) End Sub '*********************************************************************************************** '* 処理名 ：ShowFatalMessage '* 機能 ：致命例外メッセージ編集 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = プログラムタイトル(String) '* Arg2 = メッセージヘッダ(String) '* Arg3 = 例外メッセージ(String) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年03月02日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Friend Sub ShowFatalMessage(ByVal strTitle As String, _ ByVal strMSGHeader As String, _ ByVal strExMessage As String) '------------------------------------------------------------------------------------------- Dim strErrMSG As String = strMSGHeader ' メッセージ ' ヘッダ無し If strMSGHeader.Length = 0 Then strErrMSG = strExMessage Else strErrMSG &= "でエラーが発生しました。" & ControlChars.CrLf & strExMessage strErrMSG &= ControlChars.CrLf & ControlChars.CrLf strErrMSG &= "Excelプロセスが残存する場合があります。" & ControlChars.CrLf strErrMSG &= "不具合が解消しない場合はWindowsを再起動して下さい。" End If MessageBox2.DialogShow(g_objOwnerForm, _ strErrMSG, _ strTitle, _ MessageBoxButtons.OK, _ MessageBoxIcon.Error) End Sub '*********************************************************************************************** ' ■■■ 共通サブ処理(Private) ■■■ '*********************************************************************************************** '* 処理名 ：GP_ReleaseComObject '* 機能 ：COMオブジェクトの解放 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：Arg1 = COMオブジェクト(Object) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub GP_ReleaseComObject(ByRef objCOM As Object) '------------------------------------------------------------------------------------------- ' 明示的にCOMオブジェクトへの参照を解放する Try ' ランタイム呼び出し可能ラッパーの参照カウントをデクリメント If ((Not objCOM Is Nothing) AndAlso (Marshal.IsComObject(objCOM))) Then Marshal.FinalReleaseComObject(objCOM) End If Finally ' 参照を解除する objCOM = Nothing End Try End Sub '*********************************************************************************************** '* 処理名 ：GP_ReleaseAllExObject '* 機能 ：確保しているExcel関連全てオブジェクトの解放 '----------------------------------------------------------------------------------------------- '* 返り値 ：(なし) '* 引数 ：(なし) '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Sub GP_ReleaseAllExObject() '------------------------------------------------------------------------------------------- ' 新規インスタンスか If g_swNewInstance Then Try ' Excel.Workbooksが確保されている場合は全てのWorkbookを強制的に閉じる For Each objWbk As Excel.Workbook In g_objWorkbooks ' 強制的に閉じる objWbk.Saved = True objWbk.Close(False) ' Excel.Workbookの解放 Call GP_ReleaseComObject(objWbk) Next objWbk Catch ex As Exception ' 無視 End Try End If ' Excel.Workbooksの解放 Call GP_ReleaseComObject(g_objWorkbooks) ' Excel.Applicationの解放 Call GP_ReleaseComObject(g_objExcel) End Sub '*********************************************************************************************** '* 処理名 ：FP_CheckExistsFile '* 機能 ：ファイル存在確認 '----------------------------------------------------------------------------------------------- '* 返り値 ：チェック成否(Boolean) '* 引数 ：Arg1 = 存在チェックするファイル名(String) ※フルパスで指定 '* Arg2 = テンプレート判定(Boolean) ※Ref参照 '* Arg3 = ブック名(大文字変換)(String) ※Ref参照 '* Arg4 = 例外時メッセージヘッダ(String) ※Ref参照 '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月02日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項：URL上のファイルには対応しません、例外処理はありません '*********************************************************************************************** Private Function FP_CheckExistsFile(ByVal strFilename As String, _ ByRef blnTemplate As Boolean, _ ByRef strBooknameU As String, _ ByRef strMSGHeader As String) As Boolean '------------------------------------------------------------------------------------------- Dim objFileInfo As FileInfo = New FileInfo(strFilename) ' FileInfo Dim strExt As String = objFileInfo.Extension.ToUpper ' 拡張子 Dim strMSG As String = String.Empty ' メッセージ strMSGHeader = "ファイル存在チェック" strBooknameU = objFileInfo.Name.ToUpper ' 拡張子判定 If ((strExt = g_cnsXLT) OrElse (strExt = g_cnsXLTM) OrElse (strExt = g_cnsXLTX)) Then blnTemplate = True End If ' ファイルが見つからない If Not objFileInfo.Exists Then ' 拡張子判定 If blnTemplate Then strMSG = "指定のテンプレートが存在しません。" Else strMSG = "指定のワークブックが存在しません。" End If strMSG &= ControlChars.CrLf & strFilename MessageBox2.DialogShow(g_objOwnerForm, _ strMSG, _ g_objOwnerForm.Text, _ MessageBoxButtons.OK, _ MessageBoxIcon.Error) Return False Else Return True End If End Function '*********************************************************************************************** '* 処理名 ：FP_OpenNewWorkbook '* 機能 ：新規ワークブックを開く '----------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = Excel.Workbook(Object) ※Ref参照 '* Arg2 = 例外時メッセージヘッダ(String) ※Ref参照 '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年02月26日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Function FP_OpenNewWorkbook(ByRef objWBK As Excel.Workbook, _ ByRef strMSGHeader As String) As Boolean '------------------------------------------------------------------------------------------- strMSGHeader = "新規ワークブックを開く" ' 新規インスタンスか？ If (g_swNewInstance AndAlso (g_objWorkbooks.Count <> 0)) Then objWBK = g_objWorkbooks(1) Else objWBK = g_objWorkbooks.Add End If Return True End Function '*********************************************************************************************** '* 処理名 ：FP_OpenExiWorkbook '* 機能 ：既存ワークブックを開く '----------------------------------------------------------------------------------------------- '* 返り値 ：処理成否(Boolean) '* 引数 ：Arg1 = ワークブックファイル名(String) ※フルパスで指定 '* Arg2 = テンプレート判定(Boolean) '* Arg3 = ブック名(大文字変換)(String) '* Arg4 = 引数UpdateLinks(Int16) '* Arg5 = 引数ReadOnly(Boolean) '* Arg6 = Excel.Workbook(Object) ※Ref参照 '* Arg7 = 例外時メッセージヘッダ(String) ※Ref参照 '----------------------------------------------------------------------------------------------- '* 作成日 ：2017年02月26日 '* 作成者 ：井上 治 '* 更新日 ：2017年04月11日 '* 更新者 ：井上 治 '* 機能説明： '* 注意事項： '*********************************************************************************************** Private Function FP_OpenExiWorkbook(ByVal strFileName As String, _ ByVal blnTemplate As Boolean, _ ByVal strBooknameU As String, _ ByVal intUpdateLinks As Int16, _ ByVal blnReadOnly As Boolean, _ ByRef objWBK As Excel.Workbook, _ ByRef strMSGHeader As String) As Boolean '------------------------------------------------------------------------------------------- strMSGHeader = "既存ワークブックを開く" ' テンプレートか If blnTemplate Then ' 初期イベント状態(モジュール変数にて設定) g_objExcel.EnableEvents = g_swExcelEnableEvents ' テンプレート(*.xlt,*.xltm,*.xltx)時は新規ブックで開く objWBK = g_objWorkbooks.Add(strFileName) Else ' ワークブック(*.xls,*.xlsm,*.xlsx)等の場合は既に開いているか判断 If Not g_swNewInstance Then ' 開いているブックを巡回 For Each objWBK2 As Excel.Workbook In g_objWorkbooks ' フルネームの一致はそのファイルの処理とする(正常扱い) If objWBK2.FullName.ToUpper = strFileName.ToUpper Then objWBK = objWBK2 Return True End If Next objWBK2 ' 開いているブックを巡回 For Each objWBK2 As Excel.Workbook In g_objWorkbooks ' ブック名のみ一致はNG If objWBK2.Name.ToUpper = strBooknameU Then ' ブック名の衝突 Dim strMSG As String = _ "指定ワークブックと同じブック名のファイルが開かれています。" ' ﾒｯｾｰｼﾞ MessageBox2.DialogShow(g_objOwnerForm, _ strMSG, _ g_objOwnerForm.Text, _ MessageBoxButtons.OK, _ MessageBoxIcon.Error) ' Excel.Workbookの解放 Call GP_ReleaseComObject(objWBK) Return False End If Next objWBK2 End If ' 初期イベント状態(モジュール変数にて設定) g_objExcel.EnableEvents = g_swExcelEnableEvents ' ワークブック(*.xls等)時は開く objWBK = g_objWorkbooks.Open(strFileName, intUpdateLinks, blnReadOnly) End If Return True End Function '*********************************************************************************************** ' ■■■ プロパティ ■■■ '*********************************************************************************************** ' 処理中断スイッチ(Boolean) '----------------------------------------------------------------------------------------------- Friend Property prpPrintCancel() As Boolean Get Return g_swPrintCancel End Get Set(ByVal value As Boolean) g_swPrintCancel = value End Set End Property '=============================================================================================== ' 出力処理中スイッチ(Boolean) '----------------------------------------------------------------------------------------------- Friend Property prpExcelDuringProc() As Boolean Get Return g_swExcelDuringProc End Get Set(ByVal value As Boolean) g_swExcelDuringProc = value End Set End Property '=============================================================================================== ' ブックOPEN時のイベント状態(イベント停止する場合はFP_GetWorkbookを呼ぶ前にFalseにする) '----------------------------------------------------------------------------------------------- Friend Property prpExcelEnableEvents() As Boolean Get Return g_swExcelEnableEvents End Get Set(ByVal value As Boolean) g_swExcelEnableEvents = value End Set End Property '=============================================================================================== ' Excel.Application(Obnject) ※既にExcelインスタンスが確保されている前提 '----------------------------------------------------------------------------------------------- Friend ReadOnly Property ExApp As Excel.Application Get Return g_objExcel End Get End Property '=============================================================================================== ' Excel.Workbooks(Obnject) ※既にExcelインスタンスが確保されている前提 '----------------------------------------------------------------------------------------------- Friend ReadOnly Property ExWorkbooks As Excel.Workbooks Get Return g_objWorkbooks End Get End Property '---------------------------------------<< End of Source >>------------------------------------- End Class
- Excelの処理では処理例外を完全に避けることはできません。
-
VB.NETプログラムからExcelへ出力を行なうのがこのページでの説明の目的なのですが、注意していただくことがあります。
Excelというのは本来、デスクトップ上で操作者がウィンドウ上で扱うアプリケーションだということです。 VB.NETプログラムからはこれを本来ウィンドウ上に表示されない「プロセス」として利用するので、 仕組みに不良がなくても操作者の操作との衝突で処理例外が発生して異常終了することが発生します。 これは「プロセス」側の方が立場が弱いため、プログラムの記述では避けることはできません。
これはプログラムのエラーではなく、Excelの「最近使ったブック」でファイルを開こうとしたところ、そのワークブックが削除あるいは移動してしまっている時に表示されるエラーメッセージです。
Excelの操作側でこのような実行時エラーのメッセージが出たままにしている、あるいは印刷や書式設定などのダイアログが表示された状態、 さらにはセル編集モード状態だとかでマクロが動かない状態だと、このまま本プログラムを実行した場合も処理例外となってしまいます。
「新規インスタンス(新規にExcelを起動)」の方はかなり救済されますが、 Excelのバージョンによっても動作に差異があるようです。
また、このサンプルプログラムはすぐに処理が完了してしまいますが、処理時間が長い場合は逆に処理中に操作者が別のExcelドキュメントを起動してしまうということもあって、 処理例外を完全に避ける方法はありません。
Excelの操作側での先のメッセージが表示さたままで「既存インスタンス(開いているExcelに出力)」で 本プログラムを実行すると、このメッセージが表示されるはずです。
このエラーメッセージの「○○でエラーが発生しました。」の「○○」の部分はソース上の変数strMSGHeaderにセットされた文字列です。
処理例外は一部はクラス内でトラップしていますが、それ以外はExcel出力フォームの「Form_Shown」イベント内のエラートラップに集約されており、 このメッセージによりどの工程で例外が発生したのかがある程度判ります。
この画像だと、クラス側の「FP_OpenExiWorkbook」だということになります。
本プログラムでは1つ前のメッセージの表示は既に処理失敗の例外処置に入っており、1つ前のメッセージの「OK」ボタンクリックで 後始末としてExcel等のインスタンスの解放を試みますが、先のExcelの操作側のメッセージ等が始末されないままだと 本プログラムの「後始末」も失敗してこのようなシステムメッセージが表示されてしまいます。
先のExcelの操作側のメッセージ等をクリアさせてから1つ前のメッセージの「OK」ボタンをクリックして原因をクリアしてやれば このシステムメッセージは表示されることなく本プログラムの「後始末」は正常に行なわれます。(今回の処理自体は失敗ですが)
例えば、先頭のエラーメッセージが表示されている状態で、手操作でフォルダから別のワークブックを開こうとすると、フォルダウィンドウは砂時計のままになってしまいます。 エラーメッセージの「OK」をクリックすると突然指定したワークブックが開きます。
本プログラムの場合は手操作と違って「新規インスタンス(新規にExcelを起動)」が選択できますが、 エラーメッセージが表示されている状態で「新規インスタンス(新規にExcelを起動)」を選択すれば、このケースではこのプログラムは問題なく動作します。
では「新規インスタンス(新規にExcelを起動)」なら問題がないのかというと全てのケースで問題ないわけではなく、 詳細は明らかではありませんが、特に他のマクロの動作中はダメなようです。
プログラムの利用者にはこのようなケースが起こることについての啓蒙、教育も必要なのでご理解の上でシステム化していって下さい。
フォーム画面が崩れる時は．．．
近年の「高DPIノートPC」をWindows7以前のバージョンで使用している場合は、
フォームやコントロールの大きさが変わらないのに文字だけ大きくなってしまうのでフォーム画面が崩れた状態に表示されてしまいます。
Windows8.1以降ではOS側がスクリーンごとのDPI設定を含めて補正してしまうので問題ないのですが、 Windows7以前ではプログラム側で対策を講じる必要があります。
本件については「DPI制御の問題」をご覧下さい。
Windows8.1以降ではOS側がスクリーンごとのDPI設定を含めて補正してしまうので問題ないのですが、 Windows7以前ではプログラム側で対策を講じる必要があります。
本件については「DPI制御の問題」をご覧下さい。