Option Compare Database
Option Explicit
Public Sub CreateMenu()
On Error Resume Next
CommandBars("Menu").Delete
On Error GoTo Error_Handler:
Dim CommandBar As Office.CommandBar
Set CommandBar = CommandBars.Add("Menu", msoBarPopup)
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&1"
.OnAction = "=BTN1_Click()"
.FaceId = 501
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "Form&2"
.OnAction = "=BTN2_Click()"
.FaceId = 502
End With
With CommandBar.Controls.Add(msoControlButton)
.Caption = "ماشین حساب"
.OnAction = "=BTN3_Click()"
.FaceId = 283
End With
Set CommandBar = Nothing
Exit Sub
Error_Handler:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Public Function BTN1_Click()
DoCmd.OpenForm "Form1"
End Function
Public Function BTN2_Click()
DoCmd.OpenForm "Form2"
End Function
Public Function BTN3_Click()
Shell ("calc.exe")
End Function