Office中国论坛/Access中国论坛
标题: [求助]提示：参数类型不正确，或不在可以接受的范围之内，或与其他参数冲突。 [打印本页]
作者: sunwrsun 时间: 2017-2-3 13:44
标题: [求助]提示：参数类型不正确，或不在可以接受的范围之内，或与其他参数冲突。
[求助]前台A床cess，后台SQL。登录提示：参数类型不正确，或不在可以接受的范围之内，或与其他参数冲突。
'创建系统菜单栏
Public Sub CreateMenuBar()
On Error GoToErr_CreateMenuBar
Const strMenubarName As String ="CustomSystemMenu" '自定义系统菜单栏名称
Dim rst As New ADODB.Recordset
Dim bar As Object
Dim bar2 As Object
Dim ctl As Object
Dim rst2 As New ADODB.Recordset
Dim strSql As String
Dim strSQL2 As String
Dim blnHide As Boolean
'循环所有菜单栏，如果定义名称的菜单栏存在，则将其删除
For Each bar In Application.CommandBars
If bar.Name = strMenubarName ThenCommandBars(strMenubarName).Delete
Next
'重新创建菜单栏
Set bar = CommandBars.Add(strMenubarName,1, True, True) 'msoBarTop=1
bar.Protection = 4 'msoBarNoMove 禁止移动菜单栏
'读取设置决定是否显示无权访问的菜单及菜单项
blnHide =GetDbSetting("HideMenuForNoRight", False)
strSql = " SELECTFUserId,USysMenuItems.FItemId, FItemText, FShortcutKey,FParent,FOpenRun,FAdd,FEdit,FDelete,FPrint,FOutput" & _
" FROM USysUserRights RIGHTJOIN USysMenuItems ON USysUserRights.FItemId = USysMenuItems.FItemId"& _
" WHERE FParent=0 AndFUserId=" & Forms!frmLogon!txtUserId
If blnHide Then strSql = strSql &" AND FOpenRun=True"
strSql = strSql & " ORDER BYFOrder"
' Debug.Print strSQL2
strSQL2 = " SELECTT.FOrder,T.FItemId,T.FItemText,T.FCommand,T.FArgument,T.FShortcutKey,T.FParent,"& _
"R.FOpenRun,R.FAdd,R.FEdit,R.FDelete,R.FPrint,R.FOutput" &_
" FROM (USysUserRightsAS R RIGHT JOIN USysMenuItems AST ON R.FItemId = T.FItemId)" & _
" WHERE R.FUserId="& Forms!frmLogon!txtUserId
If blnHide Then strSQL2 = strSQL2 &" AND R.FOpenRun=True"
strSQL2 = strSQL2 & " ORDER BYT.FOrder"
' Debug.Print strSQL2
rst.Open strSql, CurrentProject.Connection,adOpenKeyset, adLockReadOnly
rst2.Open strSQL2,CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Do Until rst.EOF
Set bar =CommandBars(strMenubarName).Controls.Add(10) 'msoControlPopup=10
bar.Caption = rst!FItemText &rst!FShortcutKey
If Not blnHide Then bar.Enabled =rst!FOpenRun
rst2.Filter = "FParent="& rst!FItemId
Do Until rst2.EOF
Set ctl =bar.CommandBar.Controls.Add(1) 'msoControlButton
ctl.Caption = Nz(rst2!FItemText) &Nz(rst2!FShortcutKey)
If Not blnHide Then ctl.Enabled =rst!FOpenRun And rst2!FOpenRun
If ctl.Enabled Then ctl.OnAction ="=RunMenuCommand('" & Nz(rst2!FCommand) & "','"& Nz(rst2!FArgument) & "'," & _
(rst!FOpenRun And rst2!FOpenRun) & "," & (rst!FAdd Andrst2!FAdd) & "," & _
(rst!FEdit And rst2!FEdit) & "," & (rst!FDelete Andrst2!FDelete) & "," & _
(rst!FPrintAnd rst2!FPrint) & "," & (rst!FOutput And rst2!FOutput) &")"
rst2.MoveNext
Loop
rst.MoveNext
Loop
rst.Close
rst2.Close
CommandBars(strMenubarName).Visible = True
Exit_CreateMenuBar:
Exit Sub
Err_CreateMenuBar:
Msgbox "ModRight Sub_CreateMenuBar" & vbCr &Err.Description, vbCritical
Resume Exit_CreateMenuBar
End Sub
作者: roych 时间: 2017-2-3 14:35
别的没留意到，然而部分语句似乎少了空格：
If bar.Name = strMenubarName ThenCommandBars(strMenubarName).Delete
应为：
If bar.Name = strMenubarName Then CommandBars(strMenubarName).Delete
SQL语句错得太多，懒得说了。select、where 、and、order by……自己检查吧。
作者: sunwrsun 时间: 2017-2-3 21:33
十分感谢roych帮助，我试试看。
作者: sunwrsun 时间: 2017-2-3 21:46
我检查了一下如roych所说源代码的部分语句似本来是有空格的，我是先复制到Word后再复制到论坛上，就出现了部分语句少了空格。所以未在意。我现在直接复制上来，麻烦roych再看看，谢谢。
'创建系统菜单栏
Public Sub CreateMenuBar()
On Error GoTo Err_CreateMenuBar
Const strMenubarName As String = "CustomSystemMenu" '自定义系统菜单栏名称
Dim rst As New ADODB.Recordset
Dim bar As Object
Dim bar2 As Object
Dim ctl As Object
Dim rst2 As New ADODB.Recordset
Dim strSql As String
Dim strSQL2 As String
Dim blnHide As Boolean
'循环所有菜单栏，如果定义名称的菜单栏存在，则将其删除
For Each bar In Application.CommandBars
If bar.Name = strMenubarName Then CommandBars(strMenubarName).Delete
Next
'重新创建菜单栏
Set bar = CommandBars.Add(strMenubarName, 1, True, True) 'msoBarTop=1
bar.Protection = 4 'msoBarNoMove 禁止移动菜单栏
'读取设置决定是否显示无权访问的菜单及菜单项
blnHide = GetDbSetting("HideMenuForNoRight", False)
strSql = " SELECT FUserId,USysMenuItems.FItemId, FItemText, FShortcutKey, FParent,FOpenRun,FAdd,FEdit,FDelete,FPrint,FOutput" & _
" FROM USysUserRights RIGHT JOIN USysMenuItems ON USysUserRights.FItemId = USysMenuItems.FItemId" & _
" WHERE FParent=0 And FUserId=" & Forms!frmLogon!txtUserId
If blnHide Then strSql = strSql & " AND FOpenRun=True"
strSql = strSql & " ORDER BY FOrder"
' Debug.Print strSQL2
strSQL2 = " SELECT T.FOrder,T.FItemId,T.FItemText,T.FCommand,T.FArgument,T.FShortcutKey,T.FParent," & _
"R.FOpenRun,R.FAdd,R.FEdit,R.FDelete,R.FPrint,R.FOutput" & _
" FROM (USysUserRights AS R RIGHT JOIN USysMenuItems AS T ON R.FItemId = T.FItemId)" & _
" WHERE R.FUserId=" & Forms!frmLogon!txtUserId
If blnHide Then strSQL2 = strSQL2 & " AND R.FOpenRun=True"
strSQL2 = strSQL2 & " ORDER BY T.FOrder"
' Debug.Print strSQL2
rst.Open strSql, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
rst2.Open strSQL2, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
Do Until rst.EOF
Set bar = CommandBars(strMenubarName).Controls.Add(10) 'msoControlPopup=10
bar.Caption = rst!FItemText & rst!FShortcutKey
If Not blnHide Then bar.Enabled = rst!FOpenRun
rst2.Filter = "FParent=" & rst!FItemId
Do Until rst2.EOF
Set ctl = bar.CommandBar.Controls.Add(1) 'msoControlButton
ctl.Caption = Nz(rst2!FItemText) & Nz(rst2!FShortcutKey)
If Not blnHide Then ctl.Enabled = rst!FOpenRun And rst2!FOpenRun
If ctl.Enabled Then ctl.OnAction = "=RunMenuCommand('" & Nz(rst2!FCommand) & "','" & Nz(rst2!FArgument) & "'," & _
(rst!FOpenRun And rst2!FOpenRun) & "," & (rst!FAdd And rst2!FAdd) & "," & _
(rst!FEdit And rst2!FEdit) & "," & (rst!FDelete And rst2!FDelete) & "," & _
(rst!FPrint And rst2!FPrint) & "," & (rst!FOutput And rst2!FOutput) & ")"
rst2.MoveNext
Loop
rst.MoveNext
Loop
rst.Close
rst2.Close
CommandBars(strMenubarName).Visible = True
Exit_CreateMenuBar:
Exit Sub
Err_CreateMenuBar:
Msgbox "ModRight Sub_CreateMenuBar" & vbCr & Err.Description, vbCritical
Resume Exit_CreateMenuBar
End Sub
| 欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) |
Powered by Discuz! X3.3 |