Sub MyFindOne() Rem *----*----* *----*----* *----*----* *----*----* Rem 選択文字列 単発検索 処理 Rem 作譜:Hitrock Camellia Shinopy Rem 言語:Word VBA Rem 機能:選択した文字列を検索する。 Rem 注記... Rem MyFindOneを起動して、ツールバーを追加し、コマンドボタンを押して、処理を実行する。 Rem 選択範囲を指定して、[検索]ボタンを押すと、指定した文字列を検索。 Rem 選択していない状態で、[検索]ボタンを押すと、先に検索した文字列を再検索。 Rem 履歴... Rem 第1版:2006/11/01:作成。 Rem 第2版:2007/01/07 Word2007以降に対応するため、バルーン表示を廃止。ツールバー表示に変更。 Rem *----*----* *----*----* *----*----* *----*----* Rem ツールバー表示処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myTitle As String ' Dim myCmmdBar As CommandBar Dim myCtrlBttn As CommandBarControl Dim myCtrlBttnForward As CommandBarControl Rem *----*----* *----*----* *----*----* *----*----* ' Rem 既定値の設定 myTitle = "MyFindOne" ' Rem 同名ツールバーの削除 On Error Resume Next CommandBars(myTitle).Delete On Error GoTo 0 ' Set myCmmdBar = CommandBars.Add(Name:=myTitle, Position:=msoBarTop, Temporary:=True) Set myCtrlBttn = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=1, Temporary:=True) Set myCtrlBttnForward = myCmmdBar.Controls.Add(Type:=msoControlButton, Before:=2, Temporary:=True) Rem *----*----* *----*----* *----*----* *----*----* ' With myCtrlBttn .DescriptionText = "選択文字列 単発検索 処理:処理を実行します。" .Style = msoButtonIcon .Caption = myTitle .TooltipText = "検索実行!" .FaceId = 570 .OnAction = myTitle & "Bttn" End With ' With myCtrlBttnForward .DescriptionText = "選択文字列 単発検索 処理:検索方向を設定します。" .Style = msoButtonIcon .Caption = myTitle .TooltipText = "文書の末尾へ検索" .FaceId = 317 .OnAction = myTitle & "BttnMyForward" End With ' myCmmdBar.Visible = True End Sub ' MyFindOne *----*----* *----*----* *----*----* *----*----* Sub MyFindOneBttn(Optional myDummy As Boolean) Rem *----*----* *----*----* *----*----* *----*----* Rem 各ボタン処理 Rem *----*----* *----*----* *----*----* *----*----* Dim myText As String Dim myForward As Boolean Rem *----*----* *----*----* *----*----* *----*----* ' If CommandBars("MyFindOne").Controls(2).FaceId = 317 Then myForward = True ' 文書の先頭へ検索 Else myForward = False ' 文書の末尾へ検索 End If Rem *----*----* *----*----* *----*----* *----*----* ' If Selection.Range.Text = "" Then With Selection.Find .Forward = myForward .Execute ' 検索実行 End With Exit Sub End If Rem *----*----* *----*----* *----*----* *----*----* ' myText = Selection.Range.Text ' With Selection.Find .ClearFormatting .Text = myText .Replacement.Text = "" .Forward = myForward .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = True .Execute ' 検索実行 End With End Sub ' MyFindOneBttn *----*----* *----*----* *----*----* *----*----* Sub MyFindOneBttnMyForward(Optional myDummy As Boolean) With CommandBars("MyFindOne").Controls(2) If .FaceId = 317 Then .TooltipText = "文書の先頭へ検索" .FaceId = 316 Else .TooltipText = "文書の末尾へ検索" .FaceId = 317 End If End With End Sub ' MyFindOneBttnMyForward *----*----* *----*----* *----*----* *----*----*