标题:VBA代码错误,哪位大师帮忙看看错在哪里?
只看楼主
杨志斌
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2021-2-10
结帖率:0
已结贴  问题点数:20 回复次数:1 
VBA代码错误,哪位大师帮忙看看错在哪里?
Option Compare Database
Option Explicit

Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)

End Sub

Private Sub Form_Open(Cancel As Integer)
' 最小化数据库窗口并初始化本窗体。
    On Error GoTo 0
    ' 切换到默认的开关面板页面。
    Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
    Me.FilterOn = True
   
End Sub

Private Sub Form_Current()
' 更新标题并填充选项列表。
    On Error GoTo 0
    Me.Caption = Nz(Me![ItemText], "")
    FillOptions
   
End Sub

Private Sub FillOptions()
' 填充此开关面板页面的选项。

    ' 本窗体的按钮数。
    Const conNumButtons As Integer = 10
   
    Dim dbs As Database
    Dim rst As Recordset
    Dim strSQL As String
    Dim intOption As Integer
   
    ' 将输入焦点设到本窗体的第一个按钮,然后隐藏本窗体上除了
    ' 第一个外的所有按钮。你不能隐藏具有输入焦点的字段。
    Me![Option1].SetFocus
    For intOption = 2 To conNumButtons
        Me("Option" & intOption).Visible = False
        Me("OptionLabel" & intOption).Visible = False
    Next intOption
   
    ' 打开开关面板项目表(Switchboard Items),并查找此开关
    ' 面板页面的第一项。
    Set dbs = CurrentDb()
    strSQL = "SELECT * FROM [Switchboard Items]"
    strSQL = strSQL & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
    strSQL = strSQL & " ORDER BY [ItemNumber];"
    Set rst = dbs.OpenRecordset(strSQL)
   
    ' 如果此开关面板页面没有选项,显示一个消息框。
    ' 否则,用这些项目填充此开关面板页面。
    If (rst.EOF) Then
        Me![OptionLabel1].Caption = "此开关面板页面不含任何项目"
    Else
        While (Not (rst.EOF))
            Me("Option" & rst![ItemNumber]).Visible = True
            Me("OptionLabel" & rst![ItemNumber]).Visible = True
            Me("OptionLabel" & rst![ItemNumber]).Caption = rst![ItemText]
            rst.MoveNext
        Wend
    End If

    ' 关闭此记录集和数据库。
    rst.Close
    dbs.Close

End Sub

Private Function HandleButtonClick(intBtn As Integer)
' 当单击一个按钮时,调用本函数。变量intBtn指示哪一个按钮被单击。

    ' 命令常量
    Const conCmdGotoSwitchboard = 1
    Const conCmdOpenFormAdd = 2
    Const conCmdOpenFormBrowse = 3
    Const conCmdOpenReport = 4
    Const conCmdCustomizeSwitchboard = 5
    Const conCmdExitApplication = 6
    Const conCmdRunMacro = 7
    Const conCmdRunCode = 8
  
    ' 特殊情况下的错误
    Const conErrDoCmdCancelled = 2501
   
    Dim dbs As Database
    Dim rst As Recordset

On Error GoTo HandleButtonClick_Err

    ' 在开关面板项目表中查找与被单击按钮对应的项目
    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("Switchboard Items", dbOpenDynaset)
    rst.FindFirst "[SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
   
    ' 如果没有找到匹配项,报告错误并退出本函数。
    If (rst.NoMatch) Then
        MsgBox "读取开关面板项目表(Switchboard Items)时发生错误。"
        rst.Close
        dbs.Close
        Exit Function
    End If
   
    Select Case rst![Command]
        
        ' 切换到另一个开关面板。
        Case conCmdGotoSwitchboard
            Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rst![Argument]
            
        ' 以添加模式打开一个窗体。
        Case conCmdOpenFormAdd
            DoCmd.OpenForm rst![Argument], , , , acAdd

        ' 打开一个窗体。
        Case conCmdOpenFormBrowse
            DoCmd.OpenForm rst![Argument]

        ' 打开一个报表。
        Case conCmdOpenReport
            DoCmd.OpenReport rst![Argument], acPreview

        ' 自定义开关面板。
        Case conCmdCustomizeSwitchboard
            ' 处理开关面板管理器没有安装的情况(例如选择了"最小安装")。
            On Error Resume Next
            Application.Run "WZMAIN80.sbm_Entry"
            If (Err <> 0) Then MsgBox "命令不可用。"
            On Error GoTo 0
            ' 更新窗体。
            Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
            Me.Caption = Nz(Me![ItemText], "")
            FillOptions

        ' 退出本应用。
        Case conCmdExitApplication
            CloseCurrentDatabase

        ' 运行一个宏。
        Case conCmdRunMacro
            DoCmd.RunMacro rst![Argument]

        ' 运行代码。
        Case conCmdRunCode
            Application.Run rst![Argument]

        ' 其它不可识别的命令。
        Case Else
            MsgBox "未知选项。"
   
    End Select

    ' 关闭此记录集和数据库。
    rst.Close
    dbs.Close
   
HandleButtonClick_Exit:
    Exit Function

HandleButtonClick_Err:
    ' 如果此操作因为某种原因被用户取消,不显示错误消息。
    ' 继续执行到下一行。
    If (Err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox "执行该命令时发生错误。", vbCritical
        Resume HandleButtonClick_Exit
    End If
   
End Function

Private Sub Option8_Exit(Cancel As Integer)
DoCmd.Quit acQuitSaveAll
End Sub

Private Sub option9_KeyUp(KeyCode As Integer, Shift As Integer)

End Sub
搜索更多相关主题的帖子: End 面板 Case 开关 Sub 
2021-02-10 12:43
cwa9958
Rank: 10Rank: 10Rank: 10
等 级:贵宾
威 望:67
帖 子:247
专家分:1228
注 册:2006-6-25
得分:20 
嗯嗯,你是来出考题的吗?
起码你总要说明出什么问题吧。
2021-02-14 17:40



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-504853-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.020706 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved