こんばんは。
マクロで作ってみました。
>クリップボードのように右端に表示させるか
>ツールバーに表示させるようにする方法はありますでしょうか??
こんな感じでしょうか?
一通りの検索機能はあります。次の検索も可能です。
最初だけ、Auto_Open を実行してください。後は、設定したブックを開けば、検索ボックスが現れます。そのブックを閉じると、検索ボックスはなくなってしまいます。
設定されるまで、少し、時間が掛かります。
'標準モジュールに入れてお使いください。
Private c As Range
Private Fadd As String
Private Fdata As String
Sub Auto_Open()
Call CommandMenu_Add
End Sub
Sub Auto_Close()
Dim myCBCtrl As CommandBarControl
On Error Resume Next
With Application.CommandBars("WorkSheet Menu Bar")
.Controls("検索ツール(&K)").Delete
.Controls("次検索...").Delete
End With
On Error GoTo 0
End Sub
'-----------------------------------
'実行メニュー
'-----------------------------------
Sub CommandMenu_Add()
Dim myCB As CommandBar
Dim cnt As Integer
Dim myCBCtrl As CommandBarControl
On Error Resume Next
'二重設定の回避
With Application.CommandBars("WorkSheet Menu Bar")
.Controls("検索ツール(&K)").Delete
.Controls("次検索...").Delete
End With
On Error GoTo 0
'
Set myCB = Application.CommandBars("WorkSheet Menu Bar")
cnt = myCB.Controls.Count
With myCB.Controls.Add(Type:=msoControlEdit, Before:=cnt + 1, Temporary:=True)
.Caption = "検索ツール(&K)"
.TooltipText = "現在のシートの文字を検索します"
.OnAction = "MyFind"
End With
With myCB.Controls.Add(Type:=msoControlButton, Before:=cnt + 2, Temporary:=True)
.Caption = "次検索..."
.OnAction = "myNextFind"
.TooltipText = "次検索..."
.Style = msoButtonCaption
End With
Set myCBCtrl = Nothing
End Sub
Private Sub myFind()
Dim myFind As String
myFind = Application.CommandBars("WorkSheet Menu Bar").Controls("検索ツール(&K)").Text
Set c = Nothing
Fadd = ""
Fdata =""
Set c = ActiveSheet.Cells.Find( _
What:=myFind, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchByte:=False)
If Not c Is Nothing Then
Fadd = c.Address
Fdata = ActiveWorkbook.Name & "!" & ActiveSheet.Name
c.Select
Else
Beep
End If
End Sub
Private Sub myNextFind()
'次の検索
On Error GoTo ErrHandler
If c Is Nothing Then Exit Sub
If Fdata <> ActiveWorkbook.Name & "!" & ActiveSheet.Name Then
Fadd = c.Address
Fdata = ActiveWorkbook.Name & "!" & ActiveSheet.Name
End If
Set c = Cells.FindNext(c)
c.Select
If c.Address = Fadd Then
Beep
End If
Exit Sub
ErrHandler:
MsgBox "検索できませんので、新たに、検索ボックスから実行してください。", vbInformation
End Sub
お礼
はじめてマクロを使います。 ツールバー内に検索ウインドウが表示され 邪魔にならないし、常に表示させておくことができました。 ほんとうにありがとうございました。 大事に使わせていただきます。