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 *----*----*    *----*----*    *----*----*    *----*----*
inserted by FC2 system