Public Function AutoExec()
Dim rs As ADODB.Recordset
'если у вас MDB файл а не проект ADP, подставьте другу. функцию, дающее имя пользователя
Set rs = CurrentProject.Connection.Execute("SELECT SYSTEM_USER AS sUserName")
If rs!sUserName = "dbo" Or InStr(1, rs!sUserName, "МоёФамилиё") > 0 Then
Dim prop As Object
For Each prop In CurrentProject.Properties
If prop.Name = "AllowBypassKey" Then
MsgBox _
"[AllowBypassKey] property enabled", _
vbApplicationModal + vbOKOnly + vbExclamation, _
"AutoExec system message"
CurrentProject.Properties("AllowBypassKey") = True
CurrentProject.Properties.Remove ("AllowBypassKey")
GoTo Property_Found1
End If
Next prop
MsgBox _
"[AllowBypassKey] property not found", _
vbApplicationModal + vbOKOnly + vbExclamation, _
"AutoExec system message"
Property_Found1:
CurrentProject.Properties("StartupShortcutMenuBar") = ""
CurrentProject.Properties("AllowSpecialKeys") = 1
CurrentProject.Properties("AllowBuiltInToolbars") = 1
CurrentProject.Properties("AllowShortcutMenus") = 1
CurrentProject.Properties("StartUpShowStatusBar") = 1
CurrentProject.Properties("StartUpForm") = ""
CurrentProject.Properties("StartUpShowDBWindow") = 0
CurrentProject.Properties("StartUpMenuBar") = ""
CurrentProject.Properties("AllowFullMenus") = 1
CurrentProject.Properties("AllowToolbarChanges") = 1
Else
For Each prop In CurrentProject.Properties
If prop.Name = "AllowBypassKey" Then
CurrentProject.Properties("AllowBypassKey") = False
GoTo Property_Found2
End If
Next prop
CurrentProject.Properties.Add "AllowBypassKey", False
CurrentProject.Properties("AllowBypassKey") = False
Property_Found2:
CurrentProject.Properties("StartupShortcutMenuBar") = ""
CurrentProject.Properties("AllowSpecialKeys") = 0
CurrentProject.Properties("AllowBuiltInToolbars") = 0
CurrentProject.Properties("AllowShortcutMenus") = 0
CurrentProject.Properties("StartUpShowStatusBar") = 1
CurrentProject.Properties("StartUpForm") = "Form.tblDeal"
CurrentProject.Properties("StartUpShowDBWindow") = 0
CurrentProject.Properties("StartUpMenuBar") = ""
CurrentProject.Properties("AllowFullMenus") = 0
CurrentProject.Properties("AllowToolbarChanges") = 0
End If
rs.Close
Dim ctl As Office.CommandBarControl
Dim pop As Office.CommandBarPopup
Dim btn As Office.CommandBarButton
For Each ctl In Application.CommandBars("Menu bar").Controls
If ctl.Caption = "ПользовательскоеПодменюВГлавномМеню" Then
ctl.Delete
End If
Next ctl
Set pop = Application.CommandBars.Item("Menu bar").Controls.Add(msoControlPopup)
With pop
.Caption = "ПользовательскоеПодменюВГлавномМеню"
.BeginGroup = True
End With
Set btn = pop.Controls.Add(msoControlButton)
With btn
.Caption = "ПользовательскийПункт1"
.Tag = "ПользовательскийПункт1"
.OnAction = "Menu.UserForm1"
End With
Set btn = pop.Controls.Add(msoControlButton)
With btn
.Caption = "ПользовательскийПункт2"
.Tag = "ПользовательскийПункт2"
.OnAction = "Menu.UserForm2"
End With
Set btn = pop.Controls.Add(msoControlButton)
With btn
.Caption = "ПользовательскийПункт3"
.Tag = "ПользовательскийПункт3"
.OnAction = "Menu.UserForm3"
End With
End Function
Public Function AutoExit()
Dim ctl As Office.CommandBarControl
Dim pop As Office.CommandBarPopup
Dim btn As Office.CommandBarButton
For Each ctl In Application.CommandBars("Menu bar").Controls
If ctl.Caption = "ПользовательскоеПодменюВГлавномМеню" Then
ctl.Delete
End If
Next ctl
End Function
|