求助提示错误框:tellme当前提供程序不支持"索引"功能的界面
Private Sub ctExplorer1_lbItemClick(ByVal nList As Integer, ByVal nItem As Integer)On Error GoTo TC_Err
Dim func As String, mdl As String
With ctExplorer1
'点击时自动打开相应的功能,相应的功能 已经保存在项目的lbItemCargo属性中
If Not IsNull(ctExplorer1.lbItemCargo(nList, nItem)) Then
mdl = ctExplorer1.lbItemCargo(nList, nItem)
'调用openCmd打开相应功能(窗体或报表或函数)
OpenCmd mdl
Exit Sub
End If
End With
Exit Sub
TC_Err:
glMessageBox "错误:" & Err.Description
Exit Sub
End Sub
'根据参数打开对应的窗体/报表/函数
Public Sub OpenCmd(mdl As String)
On Error GoTo OC_Err
Dim Rs As ADODB.Recordset, func As String
Dim Stemps As String
Dim cn As ADODB.Connection
DoCmd.Hourglass False
Set Rs = New ADODB.Recordset
Set cn = Application.CurrentProject.Connection
Stemps = "select * from tblZstmProgItem"
Rs.Open Stemps, cn, adOpenKeyset, adLockOptimistic
Rs.Index = "ModuleID"
Rs.Seek "=", mdl
If DCount("func", "tblSysRightUserRight", "uname='" & LogUser & "' and func='" & mdl & "'") = 0 Then
glMessageBox "你没有权限使用这个功能!"
Exit Sub
End If
If Not IsNull(Rs!Form) Then
gOpenForm Rs!FInModule, Rs!Form
'DoCmd.OpenForm rs!Form
Exit Sub
Else
glMessageBox "此功能不存在,或是演示版!"
Exit Sub
End If
If Not IsNull(Rs!Qry) Then
gOpenQuery Rs!FInModule, Rs!Qry
'DoCmd.OpenQuery rs!Qry
Exit Sub
Else
glMessageBox "此功能不存在,或是演示版!"
Exit Sub
End If
If Not IsNull(Rs!func) Then
func = Rs!func & "()"
UnUsed = Eval(func)
Exit Sub
Else
glMessageBox "此功能不存在,或是演示版!"
Exit Sub
End If
Exit Sub
OC_Err:
glMessageBox "tellme" & Err.Description
Exit Sub
End Sub