※書き換え予定(23/9)
動作環境
- Microsoft® Excel® for Microsoft 365 MSO (16.0.14026.20294) 64 ビット
機能一覧
- 取得ページ
- ファイル名取得
- 「ファイル名」ボタン押下で、アクティブファイルのファイル名をテキストボックスに表示する
- 「ファイル名」ボタン押下で、アクティブファイルのファイル名をテキストボックスに表示する
- パス取得
- 「パス」ボタン押下で、アクティブファイルのパスをテキストボックスに表示する
- 「パス」ボタン押下で、アクティブファイルのパスをテキストボックスに表示する
- 取得パスオープン
- 「開く」ボタン押下で、テキストボックスに表示されているパスを開く
- 「開く」ボタン押下で、テキストボックスに表示されているパスを開く
- セル情報取得
- テキストボックスにカーソルを合わせると、アクティブセルの値をテキストボックスに表示する
- テキストボックスにカーソルを合わせると、アクティブセルの値をテキストボックスに表示する
- セルアドレス取得
- テキストボックスにカーソルを合わせると、アクティブセルのアドレスをテキストボックスに表示する
- テキストボックスにカーソルを合わせると、アクティブセルのアドレスをテキストボックスに表示する
- [共通]コピー
- 「コピー」ボタン押下で、テキストボックスに表示されている値をクリップボックスに格納する
- 「コピー」ボタン押下で、テキストボックスに表示されている値をクリップボックスに格納する
- ファイル名取得
- 操作ページ
- 保存位置設定
- テキストボックスに保存位置とするセルアドレスを入力した状態で「保存位置設定」ボタン押下、
指定セルアドレスにセルカーソルを合わせる
- テキストボックスに保存位置とするセルアドレスを入力した状態で「保存位置設定」ボタン押下、
- 拡大率設定
- テキストボックスに拡大率を入力した状態で「拡大率設定」ボタン押下、
シート拡大率を指定拡大率に変更する
- テキストボックスに拡大率を入力した状態で「拡大率設定」ボタン押下、
- プレビュー変更
- プルダウンより指定プレビュー形式を選択した状態で「プレビュー変更」ボタン押下、
プレビューを指定プレビュー形式に変更する
- プルダウンより指定プレビュー形式を選択した状態で「プレビュー変更」ボタン押下、
- ブック移動
- プルダウンより移動したいブックを選択すると、指定ブックをアクティブ状態にする
プルダウンの値は、開いているエクセルファイルすべてが設定される
- プルダウンより移動したいブックを選択すると、指定ブックをアクティブ状態にする
- シート移動
- プルダウンより移動したいシートを選択すると、指定シートをアクティブ状態にする
プルダウンの値は、ブック移動プルダウンで選択されているブックのシートすべてが設定される
- プルダウンより移動したいシートを選択すると、指定シートをアクティブ状態にする
- [共通]全シート対象
- チェックを入れた状態で各機能を実行すると、全シート対象に処理を行う
チェックを外した場合は、アクティブシートのみ処理が行われる
- チェックを入れた状態で各機能を実行すると、全シート対象に処理を行う
- 保存位置設定
- 操作2ページ
- シート保護の解除
- シート保護を解除する。パスワードが設定されている場合はスルーする
- シート保護を解除する。パスワードが設定されている場合はスルーする
- 列グループ化解除・非表示解除
- 列のグループ化を解除、および非表示列を表示する
- 列のグループ化を解除、および非表示列を表示する
- 行グループ化解除・非表示解除
- 行のグループ化を解除、および非表示行を表示する
- 行のグループ化を解除、および非表示行を表示する
- 表示固定解除
- 表示固定を解除する
- 表示固定を解除する
- [共通]全シート対象
- チェックを入れた状態で各機能を実行すると、全シート対象に処理を行う
チェックを外した場合は、アクティブシートのみ処理が行われる
- チェックを入れた状態で各機能を実行すると、全シート対象に処理を行う
- シート保護の解除
- 検索ページ
- 検索
以下の入力項目およびオプションに値を入力した状態で「検索」ボタン押下、
検索を行い、【検索結果】フォームに結果を出力する- 入力項目
- 検索範囲
- プルダウンより検索対象範囲を選択する
- 全シート→アクティブファイルの全シートを対象に検索する
- 選択範囲→アクティブセルの範囲を対象に検索する
- アクティブシート→アクティブシート全体を対象に検索する
- プルダウンより検索対象範囲を選択する
- 検索対象
- プルダウンより検索対象を選択する
- 全て→値およびコメントを対象に検索する
- 値→値のみを対象に検索する
- コメント→コメントのみを対象に検索する
- プルダウンより検索対象を選択する
- 検索値
- 検索する値を指定する。以下の2通りの検索方法がある
- 正規表現を用いずに検索
- 通常の検索を行う
- 正規表現を用いて検索
- 「正規表現を有効にする」チェックボックスにチェックを入れた状態で検索を行うと、
正規表現を用いての検索ができる。 - 「正規表現参照」ボタンを押下すると【正規表現】フォームが表示され、【正規表現】フォームで正規表現行を選択すると、検索値テキストボックスに選択した正規表現行の値が入力される
- 「正規表現を有効にする」チェックボックスにチェックを入れた状態で検索を行うと、
- 正規表現を用いずに検索
- 検索する値を指定する。以下の2通りの検索方法がある
- 検索範囲
- オプション
- 正規表現を有効にする
- 検索時に正規表現を有効にする
- 検索時に正規表現を有効にする
- 「正規表現参照」ボタン
-
正規表現の入力補助機能
- カテゴリープルダウンを選択すると、正規表現の種類をカテゴリーごとに表示できる
- 新規追加
- 一覧に正規表現を追加する
「新規」ボタンを押下すると【正規表現編集】フォームが表示される。入力項目に値を入力した状態で「登録」ボタンを押下すると正規表現一覧に追加登録される。
- 一覧に正規表現を追加する
- 削除
- 一覧から正規表現を削除する
行を選択した状態で「編集」ボタン押下、既存行の編集が行える。「削除」ボタンを押下すると正規表現一覧から削除される。
- 一覧から正規表現を削除する
- 入力項目
- カテゴリー
- カテゴリーを設定。既存のカテゴリーに存在しないカテゴリーを入力した場合、新規でカテゴリーが追加される
- 正規表現
- 検索値となる正規表現を入力
- 説明
- 正規表現の説明を設定
- カテゴリー
- 正規表現編集
- 行を選択した状態で「編集」ボタン押下、既存行の編集が行える
入力項目については上記参照
- 行を選択した状態で「編集」ボタン押下、既存行の編集が行える
-
- 該当行に色を塗る
- 検索実行時に、該当セルの背景をテキストボックスで指定された色(カラーインデックス)に塗りつぶしを行う。入力方法は2通りある。
- 入力方法
- 手動で入力する
- 「色の選択」ボタン押下
- カラーパレットが表示される。該当の色を選択するとテキストボックスに選択した色のカラーインデックスが入力される。
- 入力方法
- 検索実行時に、該当セルの背景をテキストボックスで指定された色(カラーインデックス)に塗りつぶしを行う。入力方法は2通りある。
- 正規表現を有効にする
- 検索結果の見方
- 「検索」ボタン押下後、【検索結果】フォームが表示される。
- 検索結果が一覧で表示され、行を選択すると表示されているセルアドレスにセルカーソルを合わせる
- 「コピー」ボタンを押下すると、検索結果をクリップボードに格納する
- 「検索」ボタン押下後、【検索結果】フォームが表示される。
- 入力項目
- 検索
モジュール概要
- 入力フォーム
-
Plugin
各機能を呼び出す
VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} Plugin Caption = "拡張機能" ClientHeight = 3330 ClientLeft = 45 ClientTop = 390 ClientWidth = 4530 OleObjectBlob = "Plugin.frx":0000 End Attribute VB_Name = "Plugin" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '操作ページ--------------------------------------- '保存位置設定ボタン押下時 Private Sub CellMoveBtn_Click() Call PluginMod.CellMove End Sub '保存位置設定テキストの値変更時 Private Sub CellMoveTxt_Change() Call PluginMod.CellMoveTxt End Sub 'フォーム更新ボタン押下時 Private Sub FormUpdateBtn_Click() Call PluginMod.FormUpdate End Sub Private Sub PathOpenBtn_Click() Call PluginMod.PathOpen End Sub Private Sub SearchBtn1_Click() Call PluginMod.SearchBtn1 End Sub Private Sub SearchBtn2_Click() Call PluginMod.SearchBtn2_Click End Sub '検索ボタン押下時 Private Sub SearchBtn3_Click() Call PluginMod.SearchBtn3_Click End Sub 'シート移動コンボボックスの値変更時 Private Sub SheetMoveCnb_Change() Call PluginMod.SheetMoveCnb End Sub 'ブック移動コンボボックスの値変更時 Private Sub BookMoveCmd_Change() Call PluginMod.BookMoveCmd End Sub 'プレビューボタン押下時 Private Sub ViewBtn_Click() Call PluginMod.View End Sub '拡大縮小率の変更 Private Sub ZoomBtn_Click() Call PluginMod.ZoomBtn End Sub '拡大縮小設定テキストの値変更時 Private Sub ZoomTxt_Change() Call PluginMod.ZoomTxt_Change End Sub '------------------------------------------------- '操作ページ2-------------------------------------- 'シート保護解除 Private Sub BlockUnlockBtn_Click() Call PluginMod.BlockUnloc End Sub '列グループ・非表示解除 Private Sub ColumnUngroupBtn_Click() Call PluginMod.ColumnUngroup End Sub '行グループ・非表示解除 Private Sub RowUngroupBtn_Click() Call PluginMod.RowUngroup End Sub '表示固定解除 Private Sub FreezePanesBtn_Click() Call PluginMod.FreezePanesunlock End Sub '取得ページ--------------------------------------- 'セル情報部品にマウスが重なった時 Private Sub GetCellValTxt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Call PluginMod.GetCellInfo End Sub Private Sub GetCellValLbl_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Call PluginMod.GetCellInfo End Sub 'セル情報部品にマウスが重なった時 Private Sub GetCellAddressTxt_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Call PluginMod.GetCellInfo End Sub 'ファイル名ボタン押下時 Private Sub GetFileNameBtn_Click() Call PluginMod.GetFileName End Sub 'パスボタン押下時 Private Sub GetPathBtn_Click() Call PluginMod.GetPath End Sub 'コピーボタン Private Sub FileNameCopyBtn_Click() Call PluginMod.FileNameCopy End Sub Private Sub PathCopyBtn_Click() Call PluginMod.PathCopy End Sub Private Sub GetCellValBtn_Click() Call PluginMod.GetCellVal End Sub Private Sub GetCellAddressBtn_Click() Call PluginMod.GetCellAddress End Sub '------------------------------------------------- -
RegExp
正規表現の入力補助用のフォーム
VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} RegExp Caption = "正規表現" ClientHeight = 5400 ClientLeft = 45 ClientTop = 390 ClientWidth = 11145 OleObjectBlob = "RegExp.frx":0000 StartUpPosition = 1 'オーナー フォームの中央 End Attribute VB_Name = "Regexp" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'カテゴリーコンボボックス変更時 Private Sub RegExpCmb1_Change() Call RegExpMod.RegExpCmb1_Change End Sub 'リストボックスクリック時 Private Sub RegExpLst1_Click() Call RegExpMod.RegExpLst1_Click End Sub '新規ボタン Private Sub RegExpBtn1_Click() Call RegExpMod.RegExpBtn1_Click End Sub '編集ボタン Private Sub RegExpBtn2_Click() Call RegExpMod.RegExpBtn2_Click End Sub -
RegExpInput
正規表現入力補助リストに正規表現を新規追加、または編集するフォーム
VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} RegExpInput Caption = "正規表現編集" ClientHeight = 3660 ClientLeft = 45 ClientTop = 390 ClientWidth = 4800 OleObjectBlob = "RegExpInput.frx":0000 StartUpPosition = 1 'オーナー フォームの中央 End Attribute VB_Name = "RegExpInput" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '削除ボタン Private Sub RegExpInputBtn1_Click() Call RegExpMod.RegExpInputBtn1_Click End Sub '登録ボタンクリック Private Sub RegExpInputBtn2_Click() Call RegExpMod.RegExpInputBtn2_Click End Sub -
SearchResult
検索実行時に、検索結果をリストで表示する
VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} SearchResult Caption = "検索結果" ClientHeight = 5100 ClientLeft = 45 ClientTop = 390 ClientWidth = 8265.001 OleObjectBlob = "SearchResult.frx":0000 StartUpPosition = 1 'オーナー フォームの中央 End Attribute VB_Name = "SearchResult" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'コピーボタン押下時 Private Sub SearchResultBtn1_Click() Call RegExpMod.SearchResultBtn1_Click End Sub Private Sub SearchResultLst1_Click() Call RegExpMod.SearchResultLst1_Click End Sub
-
- 標準モジュール
-
Common
共通処理モジュール
[こちらを参照](https://qiita.com/Ainou78/private/503419e9c439ac5d9d56%20 #Qiita) -
ConstMod
定数宣言用モジュールOption Explicit '###定数モジュール### ''---入力フォーム--- 'プレビュー名称 Public Const VIEW_DEFAULT As String = "標準" Public Const VIEW_PAGELAYOUT As String = "ページレイアウト" Public Const VIEW_PAGEBREAK As String = "改ページプレビュー" Public Const VIEW_PRINTVIEW As String = "×印刷プレビュー" '検索 Public Const SEARCH_AREA_SELECTED As String = "選択範囲" Public Const SEARCH_AREA_ACTIVESH As String = "アクティブシート" Public Const SEARCH_AREA_ALLSH As String = "全シート" Public Const SEARCH_TG_VAL As String = "値" Public Const SEARCH_TG_COMMENT As String = "コメント" Public Const SEARCH_TG_ALL As String = "全て" '正規表現 Public Const REG_CATEGORY_ALL As String = "全て" '---正規表現--- Public Const REG_CELL_ADDRESS As String = "(^\$?[A-Z]{1,3}\$?[1-9][0-9]{0,6}){1,10}$" ''シート名--- ''正規表現シート Public Const SH_NM_REGEXP As String = "正規表現" Public Const REGEXP_FST_ROW As Long = 3 Public Const REGEXP_FST_COL As Long = 2 -
FormCommon
入力フォーム共通処理モジュール'拡張機能フォーム共通関数 Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long Private pix As Rect, hWnd As Long, GetVal As Long Type Rect Top As Long Left As Long Right As Long Bottom As Long End Type Type WindowSize Width As Long End Type 'ユーザフォームを固定して前面に表示する------------------------------------------- Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, _ ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Const HWND_TOPMOST As Long = -1 Private Const SWP_NOSIZE As Long = &H1& Private Const SWP_NOMOVE As Long = &H2& '--------------------------------------------------------------------------------- '============================================ '表示位置 '============================================ '---表示位置の指定---- Public Sub BottomLeft(tgForm As Object) Call SetWindowPos(GetForegroundWindow, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE) hWnd = GetDesktopWindow() GetVal = GetWindowRect(hWnd, pix) tgForm.StartUpPosition = 0 tgForm.Top = (pix.Bottom * 0.75) - tgForm.Height - 45 tgForm.Left = (pix.Right * 0.75) - tgForm.Width - 22 End Sub '---フォームをモーダレスで表示する--- Sub ShowFormModeless(tgForm As Object) tgForm.Show vbModeless End Sub '===================================== 'フォーム取得 '===================================== '---Pluginフォーム--- Public Function GetPluginForm() Set GetPluginForm = Plugin End Function '---RegExpフォーム--- Public Function GetRegExpForm() Set GetRegExpForm = Regexp End Function '---RegExpInputフォーム--- Public Function GetRegExpInputForm() Set GetRegExpInputForm = RegExpInput End Function '---SearchResultフォーム--- Public Function GetSearchResultForm() Set GetSearchResultForm = SearchResult End Function '===================================== 'メソッド群 '===================================== '---クリップボードにコピーする--- Public Sub ClipBordCopy(tgVal As String) With CreateObject("Forms.TextBox.1") .MultiLine = True .Text = tgVal .SelStart = 0 .SelLength = .TextLength .Copy End With End Sub -
PluginMod
入力フォーム処理モジュール''=============================== ''メソッド群 ''=============================== '---Plugin初期化--- Public Sub InitializeForm(tgForm As Object) On Error GoTo ErrRutine Call FormCommon.BottomLeft(tgForm) Call init_OperationPage(tgForm) Call init_OperationPage2(tgForm) Call init_SearchPage(tgForm) 'イベントフラグの設定(イベント処理をする） Call PluginMod.SetEventFlgChk(True) Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---イベントフラグ--- Public Sub SetEventFlgChk(tgbol As Boolean) On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 pluginForm.EventFlgChk = tgbol Exit Sub ErrRutine: MsgBox "エラーが発生しました。ツール作成者に問い合わせしてください" End Sub '---ボタン活性化処理--- Public Sub tgObjEnabledSet(tgVal As String, tgObj As Object) On Error GoTo ErrRutine If tgVal = "" Then tgObj.Enabled = False Else tgObj.Enabled = True End If Exit Sub ErrRutine: MsgBox "エラーが発生しました。ツール作成者に問い合わせしてください" End Sub '---シート移動コンボボックス初期化--- Public Sub SheetMoveChkInit(tgForm As Object) 'シート移動の初期化 tgForm.SheetMoveCnb.Style = fmStyleDropDownList tgForm.SheetMoveCnb.Clear For Each tgSh In ActiveWorkbook.Worksheets tgForm.SheetMoveCnb.AddItem (tgSh.Name) Next tgSh End Sub ''=============================== ''最初の呼び出し ''=============================== Public Sub ShowPluginForm() On Error GoTo ErrRutine Static openFlg As Integer Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm Call FormCommon.ShowFormModeless(pluginForm) Call InitializeForm(pluginForm) openFlg = 1 Exit Sub ErrRutine: If openFlg > 0 Then MsgBox "エラーが発生したため、入力フォームが正常に起動しませんでした。" End If End Sub ''=============================== ''取得ページ（GetPage）イベント処理群 ''=============================== '---ファイル名ボタン押下時--- Public Sub GetFileName() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm pluginForm.GetFileNameTxt.Value = ActiveWorkbook.Name pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "ファイル名取得に失敗しました" End Sub '---ファイル名コピーボタン押下時--- Public Sub FileNameCopy() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm Call Common.ClipBordCopy(pluginForm.GetFileNameTxt.Value) pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "ファイル名コピーに失敗しました" End Sub '---パスボタン押下時--- Public Sub GetPath() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm pluginForm.GetPathTxt.Value = ActiveWorkbook.Path pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "パス取得に失敗しました" End Sub '---パス開くボタン押下時--- Public Sub PathOpen() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm 'フォルダが存在する場合 If Common.IsFolderExist(pluginForm.GetPathTxt.Value) = True Then 'フォルダーを開く Shell "C:\Windows\Explorer.exe " & pluginForm.GetPathTxt.Value, vbNormalFocus 'フォルダを開く End If pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "フォルダオープンに失敗しました" End Sub '---パスコピーボタン押下時--- Public Sub PathCopy() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm Call Common.ClipBordCopy(pluginForm.GetPathTxt.Value) pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "パスのコピーに失敗しました" End Sub '---セル情報_コピーボタン押下時--- Public Sub GetCellVal() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm Call Common.ClipBordCopy(pluginForm.GetCellValTxt.Value) pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "セル情報のコピーに失敗しました" End Sub '---セル情報_アドレス_コピーボタン押下時--- Public Sub GetCellAddress() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm Call Common.ClipBordCopy(pluginForm.GetCellAddressTxt.Value) pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "セルアドレスのコピーに失敗しました" End Sub '---セル情報を取得する--- Public Sub GetCellInfo() On Error GoTo ErrRutine Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm pluginForm.GetCellValTxt = ActiveCell.Value pluginForm.GetCellAddressTxt = ActiveCell.Address pluginForm.GetCellValLb2.Caption = "" Exit Sub ErrRutine: pluginForm.GetCellValLb2.Caption = "セル情報の取得に失敗しました" End Sub ''=============================== ''操作ページ（OperationPage）イベント処理群 ''=============================== '---操作ページ 初期表示時--- Sub init_OperationPage(tgForm As Object) On Error GoTo ErrRutine '保存位置設定の初期化 tgForm.CellMoveAreaChk1 = True tgForm.CellMoveTxt = "A1" '拡大縮小設定の初期化 tgForm.ZoomChk = True tgForm.ZoomTxt = "100" 'プレビューの初期化 tgForm.ViewChk = True tgForm.ViewCmb.Style = fmStyleDropDownList tgForm.ViewCmb.Clear tgForm.ViewCmb.AddItem (ConstMod.VIEW_DEFAULT) tgForm.ViewCmb.AddItem (ConstMod.VIEW_PAGEBREAK) tgForm.ViewCmb.AddItem (ConstMod.VIEW_PAGELAYOUT) tgForm.ViewCmb.AddItem (ConstMod.VIEW_PRINTVIEW) tgForm.ViewCmb.ListIndex = 1 'ブック移動の初期化 tgForm.BookMoveChk = True tgForm.BookMoveCmd.Style = fmStyleDropDownList tgForm.BookMoveCmd.Clear For Each tgBk In Application.Workbooks If tgBk.Name <> ThisWorkbook.Name Then tgForm.BookMoveCmd.AddItem (tgBk.Name) End If Next tgBk 'シート移動の初期化 tgForm.SheetMoveChk = True Call SheetMoveChkInit(tgForm) Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---操作ページ_保存位置設定ボタン押下時--- Public Sub CellMove() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgAddress As String '対象アドレス Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 '変数初期化 Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl1.Caption = "" tgAddress = pluginForm.CellMoveTxt.Value Set fstActiveSheet = ActiveSheet '入力チェック If Common.regExpMatchChk(tgAddress, ConstMod.REG_CELL_ADDRESS) = False Then pluginForm.OprarationLbl1.Caption = "セルアドレスが不正です" Else '全シート対象の場合 If pluginForm.CellMoveAreaChk1 = True Then For Each tgSh In ActiveWorkbook.Worksheets 'セル位置移動メソッドの呼び出し Call CellMoveMtd(tgSh, tgAddress) Next tgSh 'アクティブシートのみの場合 Else 'セル位置移動メソッドの呼び出し Call CellMoveMtd(ActiveSheet, tgAddress) End If '最初に開いていたシートに戻す fstActiveSheet.Activate End If Exit Sub 'エラー処理 ErrRutine: pluginForm.OprarationLbl1.Caption = "保存位置変更に失敗しました" End Sub '---セル位置移動メソッド--- Public Sub CellMoveMtd(tgSh As Worksheet, tgAddress As String) On Error GoTo ErrRutine Dim pluginForm As Object 'Pluginフォーム取得 Set pluginForm = FormCommon.GetPluginForm tgSh.Activate tgSh.Range(tgAddress).Select Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---保存位置設定テキストの値変更時--- Public Sub CellMoveTxt() On Error GoTo ErrRutine '変数 Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl1.Caption = "" If pluginForm.EventFlgChk = True Then 'ボタン活性設定メソッド Call PluginMod.tgObjEnabledSet(pluginForm.CellMoveTxt, pluginForm.CellMoveBtn) End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "システムエラー発生" End Sub '---拡大縮小率の変更--- Public Sub ZoomBtn() On Error GoTo ErrRutine '変数 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgInt As Long '対象拡大率 Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 Dim flg As Boolean Set fstActiveSheet = ActiveSheet Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl1.Caption = "" '入力チェック '数値チェック If Not IsNumeric(pluginForm.ZoomTxt.Value) Then pluginForm.OprarationLbl1.Caption = "拡大縮小率の入力値が不正です" flg = True Else tgInt = pluginForm.ZoomTxt.Value End If '限界値チェック If tgInt > 400 Or tgInt < 0 Then pluginForm.OprarationLbl1.Caption = "拡大縮小率の入力値が不正です" flg = True End If '処理 If flg = False Then '全シート対象の場合 If pluginForm.ZoomChk = True Then For Each tgSh In ActiveWorkbook.Worksheets '拡大縮小率変更メソッドの呼び出し Call ZoomSet(tgSh, tgInt) Next tgSh 'アクティブシートのみの場合 Else Call ZoomSet(ActiveSheet, tgInt) End If '最初に開いていたシートに戻す fstActiveSheet.Activate End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "拡大縮小率の変更に失敗しました" End Sub '---拡大縮小率変更--- Public Sub ZoomSet(tgSh As Worksheet, tgInt As Long) On Error GoTo ErrRutine tgSh.Activate ActiveWindow.Zoom = tgInt Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---拡大縮小設定テキストの値変更時--- Public Sub ZoomTxt_Change() On Error GoTo ErrRutine '変数 Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 pluginForm.OprarationLbl1.Caption = "" If pluginForm.EventFlgChk = True Then 'ボタン活性設定メソッド Call PluginMod.tgObjEnabledSet(pluginForm.ZoomTxt.Value, pluginForm.ZoomBtn) End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "拡大縮小率の変更に失敗しました" End Sub '---プレビューボタン押下時--- Public Sub View() On Error GoTo ErrRutine '変数 Dim tgForm As Object Dim tgView As String Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 Dim flg As Boolean Set fstActiveSheet = ActiveSheet Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 pluginForm.OprarationLbl1.Caption = "" '入力チェック If Not (pluginForm.ViewCmb.Value = ConstMod.VIEW_DEFAULT Or _ pluginForm.ViewCmb.Value = ConstMod.VIEW_PAGEBREAK Or _ pluginForm.ViewCmb.Value = ConstMod.VIEW_PAGELAYOUT Or _ pluginForm.ViewCmb.Value = ConstMod.VIEW_PRINTVIEW) Then MsgBox "TODO" flg = True End If '処理 If flg = False Then tgView = pluginForm.ViewCmb.Value '全シートが対象の場合 If pluginForm.ViewChk = True Then For Each tgSh In ActiveWorkbook.Worksheets '拡大縮小率変更メソッドの呼び出し Call ViewSet(tgSh, tgView) Next tgSh 'アクティブシートのみの場合 Else '拡大縮小率変更メソッドの呼び出し Call ViewSet(ActiveSheet, tgView) End If fstActiveSheet.Activate End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "プレビューの変更に失敗しました" End Sub '---プレビューを変更する--- Public Sub ViewSet(tgSh As Worksheet, tgView As String) On Error GoTo ErrRutine tgSh.Activate Select Case tgView '標準ページ Case ConstMod.VIEW_DEFAULT ActiveWindow.View = xlNormalView '改ページプレビュー Case ConstMod.VIEW_PAGEBREAK ActiveWindow.View = xlPageBreakPreview 'ページレイアウト Case ConstMod.VIEW_PAGELAYOUT ActiveWindow.View = xlPageLayoutView '印刷プレビュー Case ConstMod.VIEW_PRINTVIEW 'TODO 未実装 End Select Exit Sub Err.Raise Err.Number End Sub '---シート移動コンボボックスの値変更時--- Public Sub SheetMoveCnb() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object Dim bkCmbVal As String Dim errFlg As Boolean Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 pluginForm.OprarationLbl1.Caption = "" bkCmbVal = pluginForm.BookMoveCmd.Value 'ブック存在チェック If Common.IsBkExist(bkCmbVal) = False Then errFlg = True End If 'シート存在チェック If errFlg = False Then If Common.IsShExist(Application.Workbooks(bkCmbVal), pluginForm.SheetMoveCnb.Value) = False Then errFlg = True End If End If If errFlg = False Then If pluginForm.EventFlgChk = True Then 'シート移動モードがOnの場合、処理をする If pluginForm.SheetMoveChk = True And pluginForm.SheetMoveCnb.Value <> "" Then 'ブックをアクティブにする Application.Workbooks(bkCmbVal).Activate 'シートをアクティブにする ActiveWorkbook.Worksheets(pluginForm.SheetMoveCnb.Value).Activate End If End If End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "シート移動に失敗しました" End Sub '---ブック移動コンボボックスの値変更時--- Public Sub BookMoveCmd() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 pluginForm.OprarationLbl1.Caption = "" If pluginForm.EventFlgChk = True Then 'シート移動モードがOnの場合、処理をする If pluginForm.BookMoveChk = True And pluginForm.BookMoveCmd.Value <> "" Then Workbooks(pluginForm.BookMoveCmd.Value).Activate Call SheetMoveChkInit(pluginForm) End If End If Exit Sub ErrRutine: pluginForm.OprarationLbl1.Caption = "ブック移動に失敗しました" End Sub '---フォーム更新ボタン押下時--- Public Sub FormUpdate() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 '処理 Call PluginMod.InitializeForm(pluginForm) Exit Sub ErrRutine: '処理なし End Sub ''=============================== ''操作ページ2（GetPage）イベント処理群 ''=============================== '---操作ページ 初期表示時--- Sub init_OperationPage2(tgForm As Object) On Error GoTo ErrRutine '全てのチェックボックスをONにする tgForm.BlockUnlockChk1 = True tgForm.ColumnUngroupChk1 = True tgForm.RowUngroupChk1 = True tgForm.FreezePanesChk1 = True Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---シート保護解除ボタン押下時--- Sub BlockUnloc() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 '変数初期化 Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl12.Caption = "" Set fstActiveSheet = ActiveSheet '全シート対象の場合 If pluginForm.BlockUnlockChk1 = True Then For Each tgSh In ActiveWorkbook.Worksheets 'シートロック解除メソッド Call BlockUnlocMtd(tgSh) Next tgSh 'アクティブシートのみの場合 Else 'シートロック解除メソッド Call BlockUnlocMtd(fstActiveSheet) End If '最初に開いていたシートに戻す fstActiveSheet.Activate Exit Sub 'エラー処理 ErrRutine: pluginForm.OprarationLbl12.Caption = "シートのアンロックに失敗しました" End Sub '---列グループ・非表示解除ボタン押下時--- Sub ColumnUngroup() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 '変数初期化 Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl12.Caption = "" Set fstActiveSheet = ActiveSheet '全シート対象の場合 If pluginForm.ColumnUngroupChk1 = True Then For Each tgSh In ActiveWorkbook.Worksheets '列グループ解除メソッドの呼び出し Call ColumnUngroupMtd(tgSh) Next tgSh 'アクティブシートのみの場合 Else '列グループ解除メソッドの呼び出し Call ColumnUngroupMtd(fstActiveSheet) End If '最初に開いていたシートに戻す fstActiveSheet.Activate Exit Sub 'イレギュラーなエラー処理 ErrRutine: End Sub '---行グループ・非表示解除ボタン押下時--- Sub RowUngroup() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 '変数初期化 Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl12.Caption = "" Set fstActiveSheet = ActiveSheet '全シート対象の場合 If pluginForm.RowUngroupChk1 = True Then For Each tgSh In ActiveWorkbook.Worksheets '列グループ解除メソッドの呼び出し Call RowUngroupMtd(tgSh) Next tgSh 'アクティブシートのみの場合 Else '列グループ解除メソッドの呼び出し Call RowUngroupMtd(fstActiveSheet) End If '最初に開いていたシートに戻す fstActiveSheet.Activate Exit Sub 'イレギュラーなエラー処理 ErrRutine: End Sub '---行グループ・非表示解除ボタン押下時--- Sub FreezePanesunlock() On Error GoTo ErrRutine '変数宣言 Dim pluginForm As Object 'Pluginフォーム取得 Dim tgSh As Worksheet 'ループ用ワークシート変数 Dim fstActiveSheet As Worksheet 'アクティブワークシート保持 '変数初期化 Set pluginForm = FormCommon.GetPluginForm pluginForm.OprarationLbl12.Caption = "" Set fstActiveSheet = ActiveSheet '全シート対象の場合 If pluginForm.FreezePanesChk1 = True Then For Each tgSh In ActiveWorkbook.Worksheets '列グループ解除メソッドの呼び出し Call FreezePanesunlockMtd(tgSh) Next tgSh 'アクティブシートのみの場合 Else '列グループ解除メソッドの呼び出し Call FreezePanesunlockMtd(fstActiveSheet) End If '最初に開いていたシートに戻す fstActiveSheet.Activate Exit Sub 'イレギュラーなエラー処理 ErrRutine: End Sub '---シートロック解除メソッド--- Public Sub BlockUnlocMtd(tgSh As Worksheet) On Error GoTo ErrRutine tgSh.Activate tgSh.Unprotect Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---列グループ解除メソッド--- Public Sub ColumnUngroupMtd(tgSh As Worksheet) On Error Resume Next tgSh.Activate tgSh.Columns.Ungroup tgSh.Columns.hidden = False If Err.Number <> 0 Then pluginForm.OprarationLbl12.Caption = "途中の処理で失敗しました。列のグループがされていない、" & Chr(13) & "もしくは解除に失敗しました" End If Exit Sub 'エラー処理なし End Sub '---行グループ解除メソッド--- Public Sub RowUngroupMtd(tgSh As Worksheet) On Error Resume Next tgSh.Activate tgSh.Rows.Ungroup tgSh.Rows.hidden = False If Err.Number <> 0 Then pluginForm.OprarationLbl12.Caption = "途中の処理で失敗しました。行のグループがされていない、" & Chr(13) & "もしくは解除に失敗しました" End If Exit Sub 'イレギュラーなエラー処理 ErrRutine: 'エラー処理なし End Sub '---表示固定解除メソッド--- Public Sub FreezePanesunlockMtd(tgSh As Worksheet) On Error Resume Next tgSh.Activate ActiveWindow.FreezePanes = False If Err.Number <> 0 Then pluginForm.OprarationLbl12.Caption = "途中の処理で失敗しました。表示固定がされていない、" & Chr(13) & "もしくは解除に失敗しました" End If Exit Sub 'イレギュラーなエラー処理 ErrRutine: 'エラー処理なし End Sub ''=============================== ''検索ページ（SearchPage）イベント処理群 ''=============================== '---検索ページ 初期表示時--- Sub init_SearchPage(tgForm As Object) On Error GoTo ErrRutine 'コンボボックスの初期化 tgForm.SearchCmb1.Clear tgForm.SearchCmb1.Style = fmStyleDropDownList tgForm.SearchCmb1.AddItem (ConstMod.SEARCH_AREA_ALLSH) tgForm.SearchCmb1.AddItem (ConstMod.SEARCH_AREA_SELECTED) tgForm.SearchCmb1.AddItem (ConstMod.SEARCH_AREA_ACTIVESH) tgForm.SearchCmb1.ListIndex = 0 tgForm.SearchCmb2.Clear tgForm.SearchCmb2.Style = fmStyleDropDownList tgForm.SearchCmb2.AddItem (ConstMod.SEARCH_TG_ALL) tgForm.SearchCmb2.AddItem (ConstMod.SEARCH_TG_VAL) tgForm.SearchCmb2.AddItem (ConstMod.SEARCH_TG_COMMENT) tgForm.SearchCmb2.ListIndex = 0 tgForm.SearchChk1 = True Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---正規表現参照ボタン押下時--- Public Sub SearchBtn1() On Error GoTo ErrRutine Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm pluginForm.Searchlbl6.Caption = "" Call RegExpMod.SearchBtn1 Exit Sub ErrRutine: pluginForm.Searchlbl6.Caption = "正規表現フォームが開けませんでした" End Sub '---色の選択ボタン押下時--- Public Sub SearchBtn2_Click() On Error GoTo ErrRutine Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm pluginForm.SearchTxt2.Value = Common.GetColorDlg pluginForm.Searchlbl6.Caption = "" Exit Sub ErrRutine: pluginForm.Searchlbl6.Caption = "カラーパレットが開けませんでした" End Sub '---検索ボタン押下時--- Public Sub SearchBtn3_Click() On Error GoTo ErrRutine Dim pluginForm As Object Set pluginForm = FormCommon.GetPluginForm pluginForm.Searchlbl6.Caption = "" Call RegExpMod.SearchBtn3_Click Exit Sub ErrRutine: pluginForm.Searchlbl6.Caption = "検索処理に失敗しました" End Sub -
RegExpMod
正規表現検索処理モジュール''=============================== ''メソッド群 ''=============================== '---RegExp初期化--- 'TODO エラー処理 Public Sub InitializeFormRegExp(tgForm As Object) On Error GoTo ErrRutine 'リストボックスの設定 tgForm.RegExpLst1.ColumnCount = 3 tgForm.RegExpLst1.ColumnWidths = "40;200;200" 'カテゴリーボックスの設定 Call CreateCmb(tgForm.RegExpCmb1) Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---カテゴリーコンボボックス生成処理--- Sub CreateCmb(tgForm As Object) On Error GoTo ErrRutine Dim i As Long Dim tgWord As String Dim tmpVal As String Dim categoryAry() As String Dim tgRng As Range Dim tgSh As Worksheet ReDim categoryAry(0) If tgForm.Value <> "" Then tmpVal = tgForm.Value Set tgSh = ThisWorkbook.Worksheets(ConstMod.SH_NM_REGEXP) 'コンボボックスに設定する情報を取得する Set tgRng = tgSh.Cells(ConstMod.REGEXP_FST_ROW, ConstMod.REGEXP_FST_COL) Do While tgRng.Value <> "" tgWord = tgRng.Value If doubleChk(tgWord, categoryAry) = False Then categoryAry(UBound(categoryAry)) = tgWord ReDim Preserve categoryAry(UBound(categoryAry) + 1) End If Set tgRng = tgRng.Offset(1, 0) Loop 'コンボボックスに設定する tgForm.Clear tgForm.AddItem ConstMod.REG_CATEGORY_ALL For i = LBound(categoryAry) To UBound(categoryAry) - 1 tgForm.AddItem categoryAry(i) Next i '前回表示時からの値を設定する If tmpVal <> "" Then tgForm.Value = tmpVal Exit Sub ErrRutine: Err.Raise Err.Number End Sub '---カテゴリー重複チェック--- Function doubleChk(tgWord As String, categoryAry() As String) As Boolean On Error GoTo ErrRutine Dim i As Long Dim result As Boolean For i = LBound(categoryAry()) To UBound(categoryAry()) If tgWord <> "" And tgWord = categoryAry(i) Then result = True Exit For End If Next i doubleChk = result Exit Function ErrRutine: Err.Raise Err.Number End Function '---重複行取得--- Function GetDoubleRow(tgRng As Range, tgVal2 As String) As Long On Error GoTo ErrRutine Dim tgVal As String Dim result As Long If tgVal2 = "" Then result = 0 Else Do While tgRng.Value <> "" tgVal = tgRng.Value & tgRng.Offset(0, 1).Value & tgRng.Offset(0, 2).Value If tgVal = tgVal2 Then result = tgRng.Row Exit Do End If Set tgRng = tgRng.Offset(1, 0) Loop End If GetDoubleRow = result Exit Function ErrRutine: Err.Raise Err.Number End Function '---検索処理--- Function GetSearchResult(tgBk As Workbook, area As String, Target As String, searchWord As String) As Collection On Error GoTo ErrRutine Dim result As New Collection Dim areaCol As New Collection Dim tgArea As Object Dim tgSh As Worksheet Dim i As Long '=============================== '検索範囲が「全シート」の場合 If area = ConstMod.SEARCH_AREA_ALLSH Then For Each tgSh In tgBk.Worksheets areaCol.Add tgSh.UsedRange Next tgSh '検索範囲が「選択範囲」の場合 ElseIf area = ConstMod.SEARCH_AREA_SELECTED Then areaCol.Add Selection '検索範囲が「アクティブシート」の場合 ElseIf area = ConstMod.SEARCH_AREA_ACTIVESH Then areaCol.Add ActiveSheet.UsedRange End If '============================== For i = 1 To areaCol.Count Set tgArea = areaCol.Item(i) '検索対象が「値」の場合 If Target = ConstMod.SEARCH_TG_VAL Then Call SearchVal(result, tgArea, searchWord) '検索対象が「コメント」の場合 ElseIf Target = ConstMod.SEARCH_TG_COMMENT Then Call SearchComment(result, tgArea, searchWord) '検索対象が「全て」の場合 ElseIf Target = ConstMod.SEARCH_TG_ALL Then Call SearchVal(result, tgArea, searchWord) Call SearchComment(result, tgArea, searchWord) End If Next i Set GetSearchResult = result Exit Function ErrRutine: Set GetSearchResult = Nothing End Function Sub SearchVal(result As Collection, tgArea As Range, searchWord As String) On Error GoTo ErrRutine Dim searchCls As SearchResultCls Dim tgRng As Range For Each tgRng In tgArea If Common.regExpMatchChk(tgRng.Value, searchWord, True, True) Then Set searchCls = New SearchResultCls searchCls.SetTg (ConstMod.SEARCH_TG_VAL) searchCls.SetBkNm (tgRng.Parent.Parent.Name) searchCls.SetShNm (tgRng.Parent.Name) searchCls.SetCellAdd (tgRng.Address) searchCls.SetCellVal (Common.GetDeleteLfTab(tgRng.Text)) result.Add searchCls End If Next tgRng Exit Sub ErrRutine: Set searchCls = New SearchResultCls searchCls.SetBkNm ("err") searchCls.SetShNm ("err") searchCls.SetCellAdd ("err") searchCls.SetCellVal ("err") result.Add searchCls End Sub Sub SearchComment(result As Collection, tgArea As Range, searchWord As String) On Error GoTo ErrRutine Dim searchCls As SearchResultCls Dim tgRng As Range For Each tgRng In tgArea If Not tgRng.Comment Is Nothing Then If Common.regExpMatchChk(tgRng.Comment.Text, searchWord, True, True) Then Set searchCls = New SearchResultCls searchCls.SetTg (ConstMod.SEARCH_TG_COMMENT) searchCls.SetBkNm (tgRng.Parent.Parent.Name) searchCls.SetShNm (tgRng.Parent.Name) searchCls.SetCellAdd (tgRng.Address) searchCls.SetCellVal (tgRng.Comment.Text) result.Add searchCls End If End If Next tgRng Exit Sub ErrRutine: Set searchCls = New SearchResultCls searchCls.SetBkNm ("err") searchCls.SetShNm ("err") searchCls.SetCellAdd ("err") searchCls.SetCellVal ("err") result.Add searchCls End Sub ''=============================== ''RegExpイベント処理群 ''=============================== '---正規表現参照ボタン押下時--- Public Sub SearchBtn1() On Error GoTo ErrRutine Dim RegExpForm As Object: Set RegExpForm = FormCommon.GetRegExpForm Call FormCommon.ShowFormModeless(RegExpForm) Call RegExpMod.InitializeFormRegExp(RegExpForm) Exit Sub ErrRutine: Stop End Sub '---カテゴリーコンボボックス変更時--- '---リストボックスの値を表示する Public Sub RegExpCmb1_Change() On Error GoTo ErrRutine Dim itemCnt As Long Dim tgCategory As String Dim tgRng As Range Dim tgSh As Worksheet Dim RegExpForm As Object Set RegExpForm = FormCommon.GetRegExpForm hWnd = GetDesktopWindow() Set tgSh = ThisWorkbook.Worksheets(ConstMod.SH_NM_REGEXP) tgCategory = RegExpForm.RegExpCmb1.Value '正規表現シートからリストボックスに表示する情報を取得する RegExpForm.RegExpLst1.Clear Set tgRng = tgSh.Cells(ConstMod.REGEXP_FST_ROW, ConstMod.REGEXP_FST_COL) 'カテゴリーで「全て」を選択した場合、全ての情報を表示する If tgCategory = ConstMod.REG_CATEGORY_ALL Then Do While tgRng.Value <> "" RegExpForm.RegExpLst1.AddItem "" RegExpForm.RegExpLst1.List(itemCnt, 0) = tgRng.Value RegExpForm.RegExpLst1.List(itemCnt, 1) = tgRng.Offset(0, 1).Value RegExpForm.RegExpLst1.List(itemCnt, 2) = tgRng.Offset(0, 2).Value itemCnt = itemCnt + 1 Set tgRng = tgRng.Offset(1, 0) Loop '上記以外の場合、カテゴリーが一致する情報のみ表示する Else Do While tgRng.Value <> "" If tgCategory = tgRng.Value Then RegExpForm.RegExpLst1.AddItem "" RegExpForm.RegExpLst1.List(itemCnt, 0) = tgRng.Value RegExpForm.RegExpLst1.List(itemCnt, 1) = tgRng.Offset(0, 1).Value RegExpForm.RegExpLst1.List(itemCnt, 2) = tgRng.Offset(0, 2).Value itemCnt = itemCnt + 1 End If Set tgRng = tgRng.Offset(1, 0) Loop End If Exit Sub ErrRutine: Stop End Sub '---リストボックスクリック時--- '---Plaginフォームの検索ページ.検索値に選択行の検索値を反映する Public Sub RegExpLst1_Click() On Error GoTo ErrRutine Dim RegExpForm As Object: Set RegExpForm = FormCommon.GetRegExpForm Dim pluginForm As Object: Set pluginForm = FormCommon.GetPluginForm pluginForm.SearchTxt1.Value = RegExpForm.RegExpLst1.List(RegExpForm.RegExpLst1.ListIndex, 1) Exit Sub ErrRutine: Stop End Sub '---新規ボタンクリック時--- '---RegExpInputFormを表示する Public Sub RegExpBtn1_Click() On Error GoTo ErrRutine Dim RegExpInputForm As Object: Set RegExpInputForm = FormCommon.GetRegExpInputForm Call FormCommon.ShowFormModeless(RegExpInputForm) Call CreateCmb(RegExpInputForm.RegExpInputCmb1) RegExpInputForm.RegExpInputCmb1.Value = "" RegExpInputForm.RegExpInputTxt1.Value = "" RegExpInputForm.RegExpInputTxt2.Value = "" RegExpInputForm.RegExpInputLbl4.Caption = "" Exit Sub ErrRutine: Stop End Sub '---編集ボタン押下時--- '---RegExpInputFormを表示し、選択行の値を反映する Public Sub RegExpBtn2_Click() On Error GoTo ErrRutine Dim RegExpInputForm As Object: Set RegExpInputForm = FormCommon.GetRegExpInputForm Dim RegExpForm As Object: Set RegExpForm = FormCommon.GetRegExpForm '値の設定 If RegExpForm.RegExpLst1.ListIndex < 0 Then RegExpInputForm.RegExpInputCmb1.Value = "" RegExpInputForm.RegExpInputTxt1.Value = "" RegExpInputForm.RegExpInputTxt2.Value = "" RegExpInputForm.RegExpInputLbl4.Caption = "項目が選択されていないため、" & Chr(13) & "新規モードで開きました" Else RegExpInputForm.RegExpInputCmb1.Value = RegExpForm.RegExpLst1.List(RegExpForm.RegExpLst1.ListIndex, 0) RegExpInputForm.RegExpInputTxt1.Value = RegExpForm.RegExpLst1.List(RegExpForm.RegExpLst1.ListIndex, 1) RegExpInputForm.RegExpInputTxt2.Value = RegExpForm.RegExpLst1.List(RegExpForm.RegExpLst1.ListIndex, 2) RegExpInputForm.RegExpInputLbl4.Caption = "" End If Call FormCommon.ShowFormModeless(RegExpInputForm) Call CreateCmb(RegExpInputForm.RegExpInputCmb1) Exit Sub ErrRutine: Stop End Sub ''=============================== ''RegExpModInputイベント処理群 ''=============================== '---登録ボタン押下時--- Public Sub RegExpInputBtn2_Click() On Error GoTo ErrRutine Dim catRegExpInputTxt As String Dim category As String Dim regExpStr As String Dim Description As String Dim resultMsg As String Dim tgRow As Long Dim errFlg As Boolean Dim tgRng As Range Dim tgSh As Worksheet Dim RegExpForm As Object Dim RegExpInputForm As Object Set RegExpForm = FormCommon.GetRegExpForm Set RegExpInputForm = FormCommon.GetRegExpInputForm Set tgSh = ThisWorkbook.Worksheets(ConstMod.SH_NM_REGEXP) Set tgRng = tgSh.Cells(ConstMod.REGEXP_FST_ROW, ConstMod.REGEXP_FST_COL) category = RegExpInputForm.RegExpInputCmb1.Value regExpStr = RegExpInputForm.RegExpInputTxt1.Value Description = RegExpInputForm.RegExpInputTxt2.Value catRegExpInputTxt = category & regExpStr & Description '入力チェック If catRegExpInputTxt = "" Then errFlg = True resultMsg = "登録内容が全て空白です" End If '挿入行を取得 If errFlg = False Then '重複行が存在すれば、該当行番号を取得 tgRow = GetDoubleRow(tgRng, catRegExpInputTxt) '重複行が存在していなかった場合、最終行を取得 If tgRow = 0 Then tgRow = Common.GetEndRow(tgSh, ConstMod.REGEXP_FST_ROW, ConstMod.REGEXP_FST_COL) resultMsg = "新規登録成功" Else resultMsg = "上書き登録成功" End If End If 'チェック処理 If tgRow = 0 Then errFlg = True resultMsg = "処理内エラー" End If '登録処理 If errFlg = False Then tgSh.Cells(tgRow, ConstMod.REGEXP_FST_COL).Value = category tgSh.Cells(tgRow, ConstMod.REGEXP_FST_COL + 1).Value = regExpStr tgSh.Cells(tgRow, ConstMod.REGEXP_FST_COL + 2).Value = Description Call CreateCmb(RegExpForm.RegExpCmb1) End If '完了メッセージの表示 ThisWorkbook.Save RegExpInputForm.RegExpInputLbl4.Caption = resultMsg Exit Sub ErrRutine: RegExpInputForm.RegExpInputLbl4.Caption = "登録失敗" End Sub '---削除ボタン押下時--- Public Sub RegExpInputBtn1_Click() On Error GoTo ErrRutine Dim catRegExpInputTxt As String Dim category As String Dim regExpStr As String Dim Description As String Dim resultMsg As String Dim tgRow As Long Dim errFlg As Boolean Dim tgRng As Range Dim tgSh As Worksheet Dim RegExpForm As Object Dim RegExpInputForm As Object Set tgSh = ThisWorkbook.Worksheets(ConstMod.SH_NM_REGEXP) Set RegExpForm = FormCommon.GetRegExpForm Set RegExpInputForm = FormCommon.GetRegExpInputForm category = RegExpInputForm.RegExpInputCmb1.Value regExpStr = RegExpInputForm.RegExpInputTxt1.Value Description = RegExpInputForm.RegExpInputTxt2.Value catRegExpInputTxt = category & regExpStr & Description 'チェック If errFlg = False Then If catRegExpInputTxt = "" Then errFlg = True resultMsg = "削除内容が全て空白です" End If End If '重複行取得 If errFlg = False Then Set tgRng = tgSh.Cells(ConstMod.REGEXP_FST_ROW, ConstMod.REGEXP_FST_COL) tgRow = GetDoubleRow(tgRng, catRegExpInputTxt) End If 'チェック If tgRow = 0 Then errFlg = True resultMsg = "処理内エラー" End If '削除処理 If errFlg = False Then tgSh.Rows(tgRow).Delete Call CreateCmb(RegExpForm.RegExpCmb1) resultMsg = "削除成功" End If 'メッセージ表示 ThisWorkbook.Save RegExpInputForm.RegExpInputLbl4.Caption = resultMsg Exit Sub ErrRutine: RegExpInputForm.RegExpInputLbl4.Caption = "削除失敗" End Sub ''=============================== ''SearchResultイベント処理群 ''=============================== Public Sub InitializeFormSearchResultForm(tgForm As Object) On Error GoTo ErrRutine 'リストボックスの設定 tgForm.SearchResultLst1.Clear tgForm.SearchResultLst1.ColumnCount = 5 tgForm.SearchResultLst1.ColumnWidths = "30;100;100;100;100" tgForm.SearchResultLst1.AddItem "" tgForm.SearchResultLst1.List(0, 0) = "対象" tgForm.SearchResultLst1.List(0, 1) = "ブック名" tgForm.SearchResultLst1.List(0, 2) = "シート名" tgForm.SearchResultLst1.List(0, 3) = "アドレス" tgForm.SearchResultLst1.List(0, 4) = "値" Exit Sub ErrRutine: End Sub '---検索ボタン押下時--- Public Sub SearchBtn3_Click() Dim searchResultForm As Object Dim pluginForm As Object Dim searchCls As SearchResultCls Dim SearchResult As New Collection Dim tgBk As Workbook Dim area As String Dim Target As String Dim searchWord As String Dim errFlg As Boolean Dim i As Long Dim tgIndex As Long Dim colorIndex As Long Set searchResultForm = FormCommon.GetSearchResultForm Set pluginForm = FormCommon.GetPluginForm 'Pluginフォーム取得 'フォーム初期表示 Call FormCommon.ShowFormModeless(searchResultForm) Call RegExpMod.InitializeFormSearchResultForm(searchResultForm) '### 検索処理 ### Set tgBk = ActiveWorkbook area = pluginForm.SearchCmb1.Value Target = pluginForm.SearchCmb2.Value searchWord = pluginForm.SearchTxt1.Value If searchWord = "" Then pluginForm.Searchlbl6.Caption = "検索値が空白のため、検索が実行できません" errFlg = True End If If errFlg = False Then Set SearchResult = GetSearchResult(tgBk, area, Target, searchWord) End If '### 結果割り当て ### If SearchResult.Count = 0 Then errFlg = True End If If errFlg = False Then For i = 1 To SearchResult.Count Set searchCls = SearchResult.Item(i) searchResultForm.SearchResultLst1.AddItem "" searchResultForm.SearchResultLst1.List(i, 0) = searchCls.GetTg searchResultForm.SearchResultLst1.List(i, 1) = searchCls.GetBkNm searchResultForm.SearchResultLst1.List(i, 2) = searchCls.GetShNm searchResultForm.SearchResultLst1.List(i, 3) = searchCls.GetCellAdd searchResultForm.SearchResultLst1.List(i, 4) = searchCls.GetCellVal Next i End If '色の取得 If pluginForm.SearchChk2 Then If IsNumeric(pluginForm.SearchTxt2.Value) Then colorIndex = pluginForm.SearchTxt2.Value Else errFlg = True searchResultForm.SearchResultLbl1.Caption = "色の設定がされませんでした。" End If End If If pluginForm.SearchChk2 And errFlg = False Then For i = 1 To SearchResult.Count Set searchCls = SearchResult.Item(i) Workbooks(searchCls.GetBkNm).Worksheets(searchCls.GetShNm).Range(searchCls.GetCellAdd).Interior.Color = colorIndex Next i End If searchResultForm.SearchResultLbl1.Caption = SearchResult.Count & "件ヒット" End Sub '---検索結果クリック時--- Sub SearchResultLst1_Click() On Error GoTo ErrRutine Dim searchResultForm As Object Dim bkNm As String Dim ShNm As String Dim cellAdd As String Set searchResultForm = FormCommon.GetSearchResultForm bkNm = searchResultForm.SearchResultLst1.List(searchResultForm.SearchResultLst1.ListIndex, 1) ShNm = searchResultForm.SearchResultLst1.List(searchResultForm.SearchResultLst1.ListIndex, 2) cellAdd = searchResultForm.SearchResultLst1.List(searchResultForm.SearchResultLst1.ListIndex, 3) Workbooks(bkNm).Worksheets(ShNm).Activate ActiveSheet.Range(cellAdd).Select Exit Sub ErrRutine: End Sub '---コピーボタン押下時--- Sub SearchResultBtn1_Click() On Error GoTo ErrRutine Dim i As Long Dim tgVal As String Dim searchResultForm As Object Set searchResultForm = FormCommon.GetSearchResultForm For i = 0 To searchResultForm.SearchResultLst1.ListCount - 1 tgVal = tgVal & vbCrLf & _ searchResultForm.SearchResultLst1.List(i, 0) & _ vbTab & searchResultForm.SearchResultLst1.List(i, 1) & _ vbTab & searchResultForm.SearchResultLst1.List(i, 2) & _ vbTab & searchResultForm.SearchResultLst1.List(i, 3) & _ vbTab & searchResultForm.SearchResultLst1.List(i, 4) Next i tgVal = Mid(tgVal, 2, Len(tgVal)) Call Common.ClipBordCopy(tgVal) Exit Sub ErrRutine: End Sub
-
- クラスモジュール
-
ApplicationSetting
Applicationの設定変更用クラスPrivate Sub Class_Initialize() Application.DisplayAlerts = False Application.ScreenUpdating = False Application.OnKey "{F1}", "" End Sub Private Sub Class_Terminate() Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub -
FileInfoCls
ファイル情報保持クラスOption Explicit Private itemIndex_ As Long 'コレクションリストのインデックス Private filePath_ As String 'ファイルパス Private fileFullName_ As String 'ファイルフルパス Private fileName_ As String 'ファイル名 Private sheetName_ As String 'エクセルシート名 Private sheetIndex_ As String 'エクセルシートインデックス Private sheetHidden_ As String 'エクセルシート表示設定 'セット Sub SetItemIndex_(tgVal As Long) itemIndex_ = tgVal End Sub Sub SetFilePath_(tgVal As String) filePath_ = tgVal End Sub Sub SetFileFullName_(tgVal As String) fileFullName_ = tgVal End Sub Sub SetFileName_(tgVal As String) fileName_ = tgVal End Sub Sub SetSheetName_(tgVal As String) sheetName_ = tgVal End Sub Sub SetSheetIndex_(tgVal As String) sheetIndex_ = tgVal End Sub Sub SetSheetHidden_(tgVal As String) sheetHidden_ = tgVal End Sub 'ゲット Function GetItemIndex() As String GetItemIndex = itemIndex_ End Function Function GetFileFullName() As String GetFileFullName = fileFullName_ End Function Function GetFilePath() As String GetFilePath = filePath_ End Function Function GetFileName() As String GetFileName = fileName_ End Function Function GetSheetName() As String GetSheetName = sheetName_ End Function Function GetSheetIndex() As String GetSheetIndex = sheetIndex_ End Function Function GetSheetHidden() As String GetSheetHidden = sheetHidden_ End Function -
SearchResultCls
検索結果保持クラスOption Explicit Private tg_ As String Private bkNm_ As String Private shNm_ As String Private cellAdd_ As String Private cellVal_ As String 'セット Sub SetTg(tgVal As String) tg_ = tgVal End Sub Sub SetBkNm(tgVal As String) bkNm_ = tgVal End Sub Sub SetShNm(tgVal As String) shNm_ = tgVal End Sub Sub SetCellAdd(tgVal As String) cellAdd_ = tgVal End Sub Sub SetCellVal(tgVal As String) cellVal_ = tgVal End Sub 'ゲット Function GetTg() As String GetTg = tg_ End Function Function GetBkNm() As String GetBkNm = bkNm_ End Function Function GetShNm() As String GetShNm = shNm_ End Function Function GetCellAdd() As String GetCellAdd = cellAdd_ End Function Function GetCellVal() As String GetCellVal = cellVal_ End Function
-