Hello Does any one know how to a add a button to the top menu bar.

i.e. running an auto open button which then adds the following butto
to run the following code

Dim rng As Range
Dim rng2 As Range
Dim strStart As String
Dim strEnd As String

GetForm:
Sheets("extract").Visible = True
Sheets("Purchasing").Select

strStart = InputBox("Please enter start date, (dd/mm/yyyy)", "Tur
Around checker: Start Date")
strEnd = InputBox("Please enter end date, (dd/mm/yyyy)", "Turn Aroun
Checker: End Date")
Selection.AutoFilter Field:=2, Criteria1:="="
CLng(CDate(strStart)), Operator:=xlAnd, _
Criteria2:="<=" & CLng(CDate(strEnd))
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

Worksheets("extract").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Copy Destination:=Worksheets("extract").Range("A1"

--
Message posted from http://www.ExcelForum.com

Paul,

This is code to add to the Formatting toolbar


Set oCB = Application.CommandBars("Formatting")

On Error Resume Next
oCB.Controls("Sort Results").Delete
On Error GoTo 0

With oCB
With .Controls.Add(Type:=msoControlButton, temporary:=True)
.Caption = "Sort Results"
.FaceId = 210
.OnAction = "BCCCSort"
End With
End With


This adds to the menu bar


Set oCB = Application.CommandBars("Worksheet Menu Bar")

On Error Resume Next
oCB.Controls("Sort Results").Delete
On Error GoTo 0

With oCB
With .Controls.Add(Type:=msoControlButton, temporary:=True)
.Caption = "Sort Results"
.Style = msoButtonCaption
.OnAction = "BCCCSort"
End With
End With

In each case replace Caption with your id and include that in the delete
code, and replace the OnACtion value with your macro.



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"pauluk " wrote in message
...
Hello Does any one know how to a add a button to the top menu bar.

i.e. running an auto open button which then adds the following button
to run the following code

Dim rng As Range
Dim rng2 As Range
Dim strStart As String
Dim strEnd As String

GetForm:
Sheets("extract").Visible = True
Sheets("Purchasing").Select

strStart = InputBox("Please enter start date, (dd/mm/yyyy)", "Turn
Around checker: Start Date")
strEnd = InputBox("Please enter end date, (dd/mm/yyyy)", "Turn Around
Checker: End Date")
Selection.AutoFilter Field:=2, Criteria1:="=" &
CLng(CDate(strStart)), Operator:=xlAnd, _
Criteria2:="<=" & CLng(CDate(strEnd))
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With

Worksheets("extract").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Copy Destination:=Worksheets("extract").Range("A1")


---
Message posted from http://www.ExcelForum.com/