当前位置:编程学习 > VB >>

弹出错误提示框: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 New ADODB.Recordset, func As String
   Dim Stemps As String
   DoCmd.Hourglass False

   Stemps = "select * from tblZstmProgItem"
   Rs.Open Stemps, currentProject.Connection, 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 --------------------编程问答-------------------- 重新顶起 --------------------编程问答-------------------- 重启下电脑就行了  相信  我
补充:VB ,  VBA
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,