MajP
You've got your good things, and you've got mine.
- Local time
- Yesterday, 20:15
- Joined
- May 21, 2018
- Messages
- 8,528
This idea works so well, not sure why everyone has not been doing more of this. And this is just scratching the surface. You can add all types of menu items. The code is actually rather easy and would work on any database, you just have to build the queries. I loaded a large database with lots of forms, reports, and queries. You can launch any of these from the command bar.
I made 3 queries. One with forms, one with reports, one with queries.
Here is the whole code
I made 3 queries. One with forms, one with reports, one with queries.
Here is the whole code
Code:
Public Sub LoadCommandBar()
Const conBarName = "cbObjects"
Dim rsForms As DAO.Recordset
Dim rsQueries As DAO.Recordset
Dim rsReports As DAO.Recordset
Dim cbCat As Office.CommandBar
Dim cbCatCtrl As Office.CommandBarControl
Dim cbObjectCtrl As Office.CommandBarControl
Set rsForms = CurrentDb.OpenRecordset("Select * from qryforms")
Set rsQueries = CurrentDb.OpenRecordset("Select * from qryQueries")
Set rsReports = CurrentDb.OpenRecordset("Select * from qryReports")
If isCommandBar(conBarName) Then
Application.CommandBars(conBarName).Delete
End If
'Build tha bar
Set cbCat = CommandBars.Add(conBarName, msoBarPopup, False, False)
'Build the first forms selection
Set cbCatCtrl = cbCat.Controls.Add(msocontrolpopup)
cbCatCtrl.Caption = "Forms"
Do While Not rsForms.EOF
Set cbObjectCtrl = cbCatCtrl.Controls.Add()
With cbObjectCtrl
.Caption = rsForms!Name
.Tag = rsForms!Name
.OnAction = "OpenForm"
End With
rsForms.MoveNext
Loop
Set cbCatCtrl = cbCat.Controls.Add(msocontrolpopup)
cbCatCtrl.Caption = "Queries"
Do While Not rsQueries.EOF
Set cbObjectCtrl = cbCatCtrl.Controls.Add()
With cbObjectCtrl
.Caption = rsQueries!Name
.Tag = rsQueries!Name
.OnAction = "OpenQuery"
End With
rsQueries.MoveNext
Loop
Set cbCatCtrl = cbCat.Controls.Add(msocontrolpopup)
cbCatCtrl.Caption = "Reports"
Do While Not rsReports.EOF
Set cbObjectCtrl = cbCatCtrl.Controls.Add()
With cbObjectCtrl
.Caption = rsReports!Name
.Tag = rsReports!Name
.OnAction = "OpenReport"
End With
rsReports.MoveNext
Loop
End Sub
Public Function isCommandBar(strBarName As String) As Boolean
Dim cb As CommandBar
For Each cb In Application.CommandBars
If cb.Name = strBarName Then
isCommandBar = True
End If
Next cb
End Function
Public Sub OpenForm()
DoCmd.OpenForm CommandBars.ActionControl.Tag
End Sub
Public Sub OpenQuery()
DoCmd.OpenQuery CommandBars.ActionControl.Tag
End Sub
Public Sub OpenReport()
DoCmd.OpenReport CommandBars.ActionControl.Tag
End Sub