ExcelのVBAのFindメソッドで困ったエラーが発生!

ExcelのVBAでの話になります。

RangeオブジェクトのFindメソッドを使用し、指定された値を所持するセルの行位置を取得する処理を組み入れた業務APを開発される際の注意喚起になります。

実際の業務APの内容をお見せすることは出来ないため、デフォルメ化したサンプルAPで説明させていただきます。

※サンプルExcelファイルのダウンロードはこちらからどうぞ。

<サンプルAP仕様>
シート「Sheet1」上の表より、指定された値を所持するセルを探索しその行位置を結果としてメッセージ表示する。

先ずは、シート「Sheet1」の内容になります。
excel_01_00_data

 

そして、当初開発時のソースコード(VBAマクロ)

Sub 一見問題のないように見える書き方()

 Dim l_Row As Long   '探し物の行位置

 With Sheets("Sheet1")

  '■探索範囲に存在する"くじら"を探索
  l_Row = .Range("A:A").Find("くじら").Row

  MsgBox "探し物の行は[" & Format(l_Row, "#,##0") & "]です。"

 End With

End Sub

 

これを実行すると正常に処理されます。
excel_01_01_ok1

 

しかし、下記のソースコードのように探索値を変更してみたところ・・・

Sub 問題が発生します()

 Dim l_Row As Long   '探し物の行位置
 
 With Sheets("Sheet1")

  '■探索範囲に存在しない"ことり"を探索
  l_Row = .Range("A:A").Find("ことり").Row

  MsgBox "探し物の行は[" & Format(l_Row, "#,##0") & "]です。"

 End With

End Sub

 

Findメソッドの実行行で、このように結果がエラーとなります。
excel_01_02_ng1

しかも、withブロック変数の設定が原因とのこと・・・・

見てのとおりwithブロックの書き方に間違いは見られない。

しかし、エラーはwithブロック変数・・・これは困りました。

 

諸々の情報収集と検証をしたところ、原因は本当につまらないことでした。

Findメソッドで条件該当するセルを探索することが出来ないにも関わらず、Rowプロパティを要求したため「Rowプロパティを返したいけど対象のセルがありませんよ!」というエラーだったようです。

つまり、下記のソースコードのようにオブジェクトとメソッドとプロパティの3連続ピリオド結合を止めて、正しく途中経過を判定すれば良いだけだったのです。

Sub 皆様このように書きましょう()

 Dim l_Range As Range   '探し物の結果セル

 With Sheets("Sheet1")

  '■探索範囲に存在しない"ことり"を探索
  Set l_Range = .Range("A:A").Find("ことり")

  '■探索結果を判定する。
  If (Not l_Range Is Nothing) Then
   MsgBox "探し物の行は[" & Format(l_Range.Row, "#,##0") & "]です。"
  Else
   MsgBox "探し物はありませんでした。"
  End If

 End With

End Sub

 

その結果は、このとおり正常に表示されました。
excel_01_03_ok2

 

ExcelのVBAコードを記述する場合、このようにオブジェクト.メソッド.プロパティのように連続したピリオドで結合し、ソースコードの記述を楽したいと思う心情は私も理解します。

しかし、お客様へ納品する業務APとしてVBAコードを記述する際は、このような楽をすべきではありません

今回の記事では、Findメソッドを例として記載しましたが、Findメソッド以外の他のメソッドの場合も考え方は同じです。

 

今回は、このFindメソッドの原因を究明するために、本来なら出さなくてもよいあぶら汗を約1時間も出しながら苦戦することになりました。

「作れば良い」「動けば良い」ではダメなのです。

「保守しやすいか?」「エラーが発生した場合、原因究明しやすいか?」を念頭に置いて、プログラマ諸君にはVBAコードを書いていただきたいものです。

 

(検索キーワード)
オブジェクト変数または With ブロック変数が設定されていません。

簡易プログラム連携実行ツール

「Aプログラム」が終了した後で、「Bプログラム」を実行したい。そして、「Bプログラム」が終了した後で、「Cプログラム」を・・・・

なんて、業務要件に皆様一度は遭遇したことはあるのではないでしょうか?

Microsoft Access 2013を使用し、上記要件を満たすサンプルツールを作成してみました。

これだけでも、簡易的なプログラム連携処理が可能です。

本サンプルツールをダウンロードした状態だと、「メモ帳」→「電卓」→「コマンドプロンプト」→「Windowsのバージョン情報」と4個のプログラムの連携実行をお試しいただけます。

皆様の業務案件の一助になれば幸いです。

 

<本サンプルツールについて>

  • こちらより、ご自由にダウンロードして下さい。 (^_^)
  • 処理仕様概要は「Shell関数で起動したプログラムの終了を待つ」という内容になっています。
  • 本サンプルツール中のサブプロシージャ「 P_ShellExecWait」により、指定されたプログラム(実行コマンド)を起動し、そのプログラムが終了するまで待機しています。

 

<本サンプルツールの稼動環境>

  • Microsoft Access (2013以降を推奨)もしくは、Microsoft Access 2013 Runtime の何れかが必要です。

 

<連携実行させたいプログラムの登録方法>

  • サンプルツール「簡易自動実行ツール.accdb」内の、ローカルテーブル「TBL_実行コマンド」に、連携実行させたい順番と、連携実行したいプログラムの起動コマンドを登録します。

※デフォルト状態※
1番目にメモ帳(notepad.exe)→2番目に電卓(calc.exe)→3番目にコマンドプロンプト(cmd.exe)→最後にWindowsバージョン表示(winver.exe)の順に実行するように設定されています。

execlist

 

<本サンプルツールの起動方法>

  • サンプルツール「簡易自動実行ツール.accdb」内の、マクロ「Start1」をダブルクリックすると、プログラムの連携実行が開始されます。

 

 

<本サンプルツールのVBAソース>


Option Compare Database
Option Explicit
'■既存のプロセスオブジェクトのハンドルを取得
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

'■指定のプロセスの終了コードを取得
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

'■開かれているオブジェクトのハンドルを解放する。
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

'■各種定数
Private Const GET_PROCESS_INFOMATION = &H400&      'プロセス情報を取得するためのパラメータコード
Private Const ACTIVE_PROCESS = &H103&              'プロセスが活動状態にあることを示すステータスコード
'■============================================================================================■
'■ 関 数 名:ExecMain
'■
'■ 処理内容:簡易自動実行ツールのメイン処理
'■
'■  引  数:なし
'■
'■ 戻 り 値:True(正常) / False(異常終了)
'■
'■  備考  :
'■
'■ <修正履歴>
'■ 2015/12/16  Transsoft      新規作成
'■  yyyy/mm/dd  xxxxx.xxxxx    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'■
'■============================================================================================■
Function ExecMain() As Boolean
On Error GoTo Err_ExecMain

Dim pv_DB_Current   As Database    'カレントDB
Dim pv_RS_Cmd       As Recordset   'テーブル「TBL_実行コマンド」

Const pc_MsgTitle = "簡易自動実行ツール"

'■===========================================================■
'■ 画面入力対象とするローカルテーブルデータを作成する。
'■===========================================================■

'■コマンド情報「TM_実行コマンド」を開く
Set pv_DB_Current = CurrentDb
Set pv_RS_Cmd = pv_DB_Current.OpenRecordset("Select * From TBL_実行コマンド Order by 実行順序; ")

'■「TM_実行コマンド」の実行順序に従い、コマンドを実行する。
Do While (pv_RS_Cmd.EOF = False)

'■コマンドを実行する。
Call P_ShellExecWait(pv_RS_Cmd.Fields("実行コマンド").Value)

'■次のコマンドを実行する。
pv_RS_Cmd.MoveNext

Loop

'■後処理
pv_RS_Cmd.Close
pv_DB_Current.Close

'■終了メッセージ
MsgBox "簡易自動実行ツールを正常終了しました。", vbInformation, pc_MsgTitle

Exit Function

'------------------------------------------------------------------------------< Error-RTN >---'
Err_ExecMain:
'■異常終了です。
MsgBox "異常状態になりました。", vbCritical, pc_MsgTitle

'■AP終了(異常終了)
DoCmd.Quit acQuitSaveNone

End Function

'■============================================================================================■
'■ 関 数 名:P_ShellExecWait
'■
'■ 処理内容:指定されたシェルコマンドを、終了するまで待機して処理する。
'■
'■  引  数:実行対象とするシェルコマンド
'■
'■ 戻 り 値:なし
'■
'■  備考  :
'■
'■ <修正履歴>
'■ 2015/12/16  Transsoft      新規作成
'■  yyyy/mm/dd  xxxxx.xxxxx    xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
'■
'■============================================================================================■
Private Sub P_ShellExecWait(in_ShellCmd As String)
On Error Resume Next

Dim pv_ProcID        As Long   '実行したシェルコマンドのプロセスID
Dim pv_ProcHandle    As Long   'プロセスIDのハンドル値
Dim pv_ProcEndStatus As Long   '該当プロセスの状態(実行状態)
Dim pv_RetCd         As Long   '諸APIの戻り値

'■指定されたシェルコマンドを実行し、プロセスIDを取得する。
pv_ProcID = Shell(in_ShellCmd, 1)

'■プロセスIDのハンドル値を取得する
pv_ProcHandle = OpenProcess(GET_PROCESS_INFOMATION, True, pv_ProcID)

'■該当プロセスが終了するまで待機する。
Do
'■該当プロセスの状態を取得する。
pv_RetCd = GetExitCodeProcess(pv_ProcHandle, pv_ProcEndStatus)

DoEvents

Loop While (pv_ProcEndStatus = ACTIVE_PROCESS)

'■ハンドル値を解放する。
pv_RetCd = CloseHandle(pv_ProcHandle)

Exit Sub

End Sub

 

よろしければ、お試し下さい。