VBAで特定のワークブック／ワークシート／オートシェイプ（図形）が存在するかチェックする
VBAで以下を実現する方法について書きます。
１．特定のワークブックが存在するか（開いているか）チェックする
２．特定のワークシートが存在するかチェックする
３．特定のオートシェイプ（図形）が存在するかチェックする
１．特定のワークブックが存在するか（開いているか）チェックする
[サンプルソース]
Public Function&Public Function checkExistBook(bookName As String) As Boolean '------------------------------------------------------------------------------------------------------ ' checkExistBook ' 対象のExcelブックを既に開いているかチェックする ' ' 引数１：bookName ･･･ 対象のExcelブック名 ' 戻り ：boolean ' '------------------------------------------------------------------------------------------------------ Dim ret As Boolean ret = False Dim b As Workbook For Each b In Workbooks If b.Name = bookName Then ret = True GoTo endProc End If Next endProc: checkExistBook = ret End Function |
ブック名称はWorkbookオブジェクトのnameプロパティから取得します。
再利用するためFunction化しています。
２．特定のワークシートが存在するかチェックする
[サンプルソース]
Public Function checkExistSheet(sheetName As String) As Boolean '------------------------------------------------------------------------------------------------------ ' checkExistSheet ' 対象のワークシートがアクティブなブック内に存在するかチェックする ' ' 引数１：sheetName ･･･ 対象のExcelワークシート名 ' 戻り ：boolean ' '------------------------------------------------------------------------------------------------------ Dim ret As Boolean checkExistSheet = ret |
シート名称はWorksheetオブジェクトのnameプロパティから取得します。
これもFunction化していますが、第2引数には、オプションでブック名を指定できるようにしています。
アクティブなブックを対象としたい場合は、引数なしにできます。
ただし任意のブック名を指定する場合、指定したブックが存在するかはチェックしないので、項番１のFunctionを呼び出すなどしてチェックが必要です。
特定のオートシェイプ（図形）が存在するかチェックする
[サンプルソース]
Public Function checkExistShape(ByVal shapeName As String, Optional ByVal sheetName = "", Optional ByVal bookName = "") As Boolean '------------------------------------------------------------------------------------------------------ ' checkExistShape ' オートシェイプが存在するかチェックする ' ' 引数１：shapeName ･･･ 対象のオートシェイプ名 ' 引数２：sheetName ･･･ シート名（省略時はActiveシート) ' 引数３：bookName ･･･ ブック名（省略時はActiveブック) ' 戻り ：boolean ' '------------------------------------------------------------------------------------------------------ Dim sName As String 'シート名 Dim bName As String 'ブック名 'シート名を設定 If sheetName = "" Then sName = ActiveSheet.Name Else sName = sheetName End If 'ブック名を設定 If bookName = "" Then bName = ActiveWorkbook.Name Else bName = bookName End If Dim ret As Boolean Dim s As Shape For Each s In Workbooks(bName).Worksheets(sName).Shapes If s.Name = shapeName Then ret = True GoTo endProc End If Next endProc: checkExistShape = ret |
Shapesコレクション(Shapeオブジェクトの集合)をループし、対象の名前のオートシェイプが存在するか検索します。
オートシェイプの名称はShapeオブジェクトのnameプロパティから取得します。
同様にFunction化しており、第2・第3引数で、シート名・ブック名を指定できます(省略可)。
任意のシート名・ブック名を指定する場合は、存在するシート・ブックであるか、あらかじめチェックしておく必要があります。
テストしてみる
Functionの呼出しだけですが、サンプルを用意しました。標準モジュールに項番１〜３のFunctionと合わせて記述して、実行してください。
なお、エラー処理については省略しています。
[サンプルソース]
Sub test() Dim tBook As String Dim tSheet As String Dim tShape As String tBook = "Book1" tSheet = "Sheet1" tShape = "図形1" If checkExistBook(tBook) Then MsgBox (tBook + "がいました") End If If checkExistSheet(tSheet) Then MsgBox (tSheet + "がいました") End If If checkExistSheet(tSheet, tBook) Then MsgBox (tBook + "に" + tSheet + "がいました") End If If checkExistShape(tShape) Then MsgBox (tShape + "がいました") End If If checkExistShape(tShape, tSheet) Then MsgBox (tSheet + "に" + tShape + "がいました") End If If checkExistShape(tShape, tSheet, tBook) Then MsgBox (tBook + "の" + tSheet + "に" + tShape + "がいました") End If End Sub |
以上です。
2014.7.2 追記
対象を発見した時点でループを抜ける処理が漏れていたため、追加しました。
ret = True GoTo endProc '← End If Next endProc: '← checkExistBook = ret |
