|
|
|
|
|
|
Excel
|
Create a custom "Worksheet Find" toolbar
|
|
Ease of Use
|
Easy
|
Version tested with
|
2002,2003
|
Submitted by:
|
Killian
|
Description:
|
This article shows how to build a custom toolbar that replicates basic Find/Find Next functionality.
|
Discussion:
|
Offers a convenient solution for users to do a simple Find/Find next on a worksheet from a toolbar rather than bringing up the native dialog.
|
Code:
|
instructions for use
|
Dim firstAddress As String, lastaddress As String
Dim ctrlStatus As CommandBarButton
Dim ctrlFN As CommandBarButton
Dim ctrlText As CommandBarControl
Dim iFindWhole As Integer
Sub BuildToolBar()
Dim TBar As CommandBar
Dim btnNew As CommandBarControl
DeleteToolbar
Set TBar = CommandBars.Add(Name:="Worksheet Find")
TBar.Visible = True
Set btnNew = TBar.Controls.Add(Type:=msoControlEdit)
With btnNew
.Caption = "Find..."
.TooltipText = "Enter search string..."
.Style = msoComboLabel
.OnAction = "FindText"
End With
Set ctrlText = btnNew
Set btnNew = TBar.Controls.Add(Type:=msoControlButton)
With btnNew
.Caption = "Find &next"
.TooltipText = "Find next"
.Style = msoButtonCaption
.OnAction = "FindNext"
.Enabled = False
End With
Set ctrlFN = btnNew
Set btnNew = TBar.Controls.Add(Type:=msoControlButton)
With btnNew
.Caption = "Match"
.TooltipText = "Match entire cell contents"
.Style = msoButtonIconAndCaption
.OnAction = "ToggleFindWhole"
iFindWhole = 1
.FaceId = 1907
End With
Set btnNew = TBar.Controls.Add(Type:=msoControlButton)
With btnNew
.Caption = ""
.TooltipText = "Result..."
.Style = msoButtonIconAndCaption
.Width = 240
End With
Set ctrlStatus = btnNew
With TBar
.Height = btnNew.Height * 3
.Protection = msoBarNoResize
End With
Set btnNew = Nothing
Set TBar = Nothing
End Sub
Sub DeleteToolbar()
Dim cb As CommandBar
For Each cb In CommandBars
If cb.Name = "Worksheet Find" Then
cb.Delete
End If
Next cb
End Sub
Sub FindText()
Dim c As Range
Set c = ActiveSheet.Cells.Find(What:=ctrlText.Text, _
LookIn:=xlValues, LookAt:=iFindWhole)
If Not c Is Nothing Then
c.Activate
ctrlFN.Enabled = True
firstAddress = c.Address
lastaddress = c.Address
ctrlStatus.Caption = """" & ctrlText.Text & """" & " found at " & lastaddress
ctrlStatus.FaceId = 1087
Else
ctrlFN.Enabled = False
firstAddress = ""
lastaddress = ""
ctrlStatus.Caption = """" & ctrlText.Text & """" & " not found"
ctrlStatus.FaceId = 1088
End If
Set c = Nothing
End Sub
Sub FindNext()
Dim c As Range
Set c = ActiveSheet.Cells.FindNext(ActiveSheet.Range(lastaddress))
If c.Address <> firstAddress Then
c.Activate
lastaddress = c.Address
ctrlStatus.Caption = """" & ctrlText.Text & """" & " found at " & lastaddress
ctrlStatus.FaceId = 1087
Else
c.Activate
ctrlFN.Enabled = False
firstAddress = ""
lastaddress = ""
ctrlStatus.Caption = """" & ctrlText.Text & """" & " - no more instances found"
ctrlText.Text = ""
ctrlStatus.FaceId = 1088
End If
Set c = Nothing
End Sub
Sub ToggleFindWhole()
If iFindWhole = 1 Then
iFindWhole = 2
CommandBars.ActionControl.FaceId = 0
Else
iFindWhole = 1
CommandBars.ActionControl.FaceId = 990
End If
End Sub
Private Sub Workbook_Open()
BuildToolBar
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
DeleteToolbar
End Sub
|
How to use:
|
- Open the VBE in a blank workbook
- Insert a new standard module (Insert>Module) and paste in the code up to "'standard module code - END"
- Go to the WorkBook code module (Double click the "ThisWorkbook" item in the Project Explorer
- Paste in the code for the workbook events
- Save and close the workbook
|
Test the code:
|
- On opening the workbook the toolbar should be visible.
- The user can toggle "Match entire cell contents" the the "Match" button
- Enter a search sting in the toolbar's text control and press Enter to search.
- The result of the search should be displayed as the "Result" control's caption.
- If the search string is found, the "Find next" button is enabled - click this to find the next instance.
|
Sample File:
|
WorksheetFindToolbar.zip 12.53KB
|
Approved by mdmackillop
|
This entry has been viewed 388 times.
|
|