问卷调查管理程序 Access数据库 功能介绍和VBA代码分享

•本系统包含主要功能有：问卷管理，题目管理，问卷填写，调查结果统计，数据汇总导出 •数据库系统包含：表，查询，窗体，VBA代码 •系统为单机使用的access数据库系统，可作为学习参考使用 系统主页

Private Sub Command更新_Click() If MsgBox("是否更新问卷记录：" & wj_name, vbYesNo) <> vbYes Then Exit Sub End If If 问卷名称2 = "" Or IsNull(问卷名称2) = True Then MsgBox "问卷名称值为空！" Exit Sub End If If wj_name = "" Then MsgBox "请先选择需要管理的问卷！" Exit Sub End If If wj_name <> Me.问卷名称2 Then If Nz(DCount("问卷名称", "问卷表", "问卷名称='" & Me.问卷名称2 & "'"), 0) > 0 Then MsgBox "该问卷名称已存在！" Exit Sub End If End If '---------------------------------------- Dim update_sql As String update_sql = "Select * From 问卷表 where 问卷名称='" & wj_name & "'" Dim update_rs As DAO.Recordset Set update_rs = CurrentDb.OpenRecordset(update_sql, dbOpenDynaset) With update_rs .Edit !问卷名称.Value = 问卷名称2.Value !问卷内容.Value = 问卷内容2.Value !问卷日期.Value = 问卷日期2.Value !备注.Value = 备注2.Value .Update .Close End With Set update_rs = Nothing MsgBox "更新完成" Me.数据表子窗体.Requery End Sub Private Sub Command清空_Click() 问卷名称.Value = "" 问卷内容.Value = "" 问卷日期.Value = "" 备注.Value = "" End Sub Private Sub Command删除_Click() If MsgBox("是否删除问卷记录：" & wj_name, vbYesNo) <> vbYes Then Exit Sub End If If wj_name = "" Then MsgBox "请先选择需要删除的问卷！" Exit Sub End If DoCmd.SetWarnings (False) Dim del_sql As String del_sql = "Delete From 问卷表 Where 问卷名称='" & wj_name & "'" DoCmd.RunSQL del_sql MsgBox "删除完成" Me.数据表子窗体.Requery wj_name = "" 问卷名称2.Value = "" 问卷内容2.Value = "" 问卷日期2.Value = "" 备注2.Value = "" End Sub Private Sub Command添加_Click() If 问卷名称 = "" Or IsNull(问卷名称) = True Then MsgBox "问卷名称值为空！" Exit Sub End If If Nz(DCount("问卷名称", "问卷表", "问卷名称='" & Me.问卷名称 & "'"), 0) > 0 Then MsgBox "该问卷名称已存在！" Exit Sub End If Dim add_rs As DAO.Recordset Set add_rs = CurrentDb.OpenRecordset("问卷表", dbOpenTable) With add_rs .AddNew !问卷名称.Value = 问卷名称.Value !问卷内容.Value = 问卷内容.Value !问卷日期.Value = 问卷日期.Value !备注.Value = 备注.Value .Update .Close End With Set add_rs = Nothing MsgBox "添加完成" Me.数据表子窗体.Requery End Sub Private Sub Command保存_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If If Me.题目ID <> "" Then '添加答题记录 Dim add_rs As DAO.Recordset Set add_rs = CurrentDb.OpenRecordset("答题表", dbOpenTable) With add_rs .AddNew ' On Error Resume Next !题目ID.Value = 题目ID.Value !答题人.Value = 答题人.Value !选项A.Value = Check选项A.Value !选项B.Value = Check选项B.Value !选项C.Value = Check选项C.Value !选项D.Value = Check选项D.Value !选项E.Value = Check选项E.Value !选项F.Value = Check选项F.Value !答题.Value = 答题.Value .Update .Close End With Set add_rs = Nothing Me.答题记录子窗体.Requery Else MsgBox "请选择题目" Exit Sub End If End Sub Private Sub Command管理题目_Click() DoCmd.OpenForm "题目管理", acNormal End Sub Private Sub Command上一题_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If Dim nowindex As Long nowindex = Me.序号 Dim minindex As Long minindex = DMin("序号", "题目表", "问卷名称='" & Me.问卷名称 & "'") If nowindex = minindex Then MsgBox "已到达第一题" Exit Sub End If '-----------------------------------取上一题 Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 题目表 Where 问卷名称='" & Me.问卷名称 & "' and 序号<" & nowindex & " order by 序号 DESC" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then Forms("系统主页").题目ID.Value = search_rs!题目ID.Value Forms("系统主页").问卷名称.Value = search_rs!问卷名称.Value Forms("系统主页").序号.Value = search_rs!序号.Value Forms("系统主页").题目.Value = search_rs!题目.Value Forms("系统主页").题目类型.Value = search_rs!题目类型.Value Forms("系统主页").选项A.Value = search_rs!选项A.Value Forms("系统主页").选项B.Value = search_rs!选项B.Value Forms("系统主页").选项C.Value = search_rs!选项C.Value Forms("系统主页").选项D.Value = search_rs!选项D.Value Forms("系统主页").选项E.Value = search_rs!选项E.Value Forms("系统主页").选项F.Value = search_rs!选项F.Value '题目图片.Value = search_rs!题目图片.Value Call 答题控件设置 Call 筛选答题记录(Me.题目ID) Call 显示题目图片(Me.题目ID) End If search_rs.Close Set search_rs = Nothing End Sub Private Sub Command上一题保存_Click() Call Command保存_Click Call Command上一题_Click End Sub Private Sub Command填空统计_Click() DoCmd.OpenForm "问卷填空题统计", acNormal End Sub Private Sub Command下一题_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If Dim nowindex As Long nowindex = Me.序号 Dim maxindex As Long maxindex = DMax("序号", "题目表", "问卷名称='" & Me.问卷名称 & "'") If nowindex = maxindex Then MsgBox "已到达最后一题" Exit Sub End If '-----------------------------------取下一题 Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 题目表 Where 问卷名称='" & Me.问卷名称 & "' and 序号>" & nowindex & " order by 序号 ASC" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then Forms("系统主页").题目ID.Value = search_rs!题目ID.Value Forms("系统主页").问卷名称.Value = search_rs!问卷名称.Value Forms("系统主页").序号.Value = search_rs!序号.Value Forms("系统主页").题目.Value = search_rs!题目.Value Forms("系统主页").题目类型.Value = search_rs!题目类型.Value Forms("系统主页").选项A.Value = search_rs!选项A.Value Forms("系统主页").选项B.Value = search_rs!选项B.Value Forms("系统主页").选项C.Value = search_rs!选项C.Value Forms("系统主页").选项D.Value = search_rs!选项D.Value Forms("系统主页").选项E.Value = search_rs!选项E.Value Forms("系统主页").选项F.Value = search_rs!选项F.Value '题目图片.Value = search_rs!题目图片.Value Call 答题控件设置 Call 筛选答题记录(Me.题目ID) Call 显示题目图片(Me.题目ID) End If search_rs.Close Set search_rs = Nothing End Sub Private Sub Command下一题保存_Click() Call Command保存_Click Call Command下一题_Click End Sub Private Sub Command选项统计_Click() DoCmd.OpenForm "问卷选项统计", acNormal End Sub Private Sub Command选择问卷_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 问卷表 Where 问卷名称='" & Me.问卷列表 & "'" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then 问卷名称.Value = search_rs!问卷名称.Value 问卷内容.Value = search_rs!问卷内容.Value 问卷日期.Value = search_rs!问卷日期.Value 备注.Value = search_rs!备注.Value End If search_rs.Close Set search_rs = Nothing '筛选数据表子窗体 Me.数据表子窗体.SourceObject = "答题题目数据表" Me.数据表子窗体.Form.Filter = "问卷名称='" & Me.问卷名称 & "'" Me.数据表子窗体.Form.FilterOn = True Me.答题记录子窗体.SourceObject = "答题查询数据表" '--------------------------------显示第一题 Dim minindex As Long minindex = Nz(DMin("序号", "题目表", "问卷名称='" & Me.问卷名称 & "'"), 0) If minindex = 0 Then MsgBox "未找到题目" Exit Sub End If '-----------------------------------取第一题 search_sql = "Select * From 题目表 Where 问卷名称='" & Me.问卷名称 & "' and 序号=" & minindex & " order by 序号 DESC" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then Forms("系统主页").题目ID.Value = search_rs!题目ID.Value Forms("系统主页").问卷名称.Value = search_rs!问卷名称.Value Forms("系统主页").序号.Value = search_rs!序号.Value Forms("系统主页").题目.Value = search_rs!题目.Value Forms("系统主页").题目类型.Value = search_rs!题目类型.Value Forms("系统主页").选项A.Value = search_rs!选项A.Value Forms("系统主页").选项B.Value = search_rs!选项B.Value Forms("系统主页").选项C.Value = search_rs!选项C.Value Forms("系统主页").选项D.Value = search_rs!选项D.Value Forms("系统主页").选项E.Value = search_rs!选项E.Value Forms("系统主页").选项F.Value = search_rs!选项F.Value '题目图片.Value = search_rs!题目图片.Value Call 答题控件设置 Call 筛选答题记录(Me.题目ID) Call 显示题目图片(Me.题目ID) End If search_rs.Close Set search_rs = Nothing End Sub Private Sub Form_Load() Me.数据表子窗体.SourceObject = "" Me.答题记录子窗体.SourceObject = "" End Sub Private Sub Command管理问卷_Click() DoCmd.OpenForm "问卷管理", acNormal End Sub Private Sub Check选项A_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项A = True Then ' Check选项A = False Check选项B = False Check选项C = False Check选项D = False Check选项E = False Check选项F = False Else Check选项A = False End If End If End Sub Private Sub Check选项B_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项B = True Then Check选项A = False ' Check选项B = False Check选项C = False Check选项D = False Check选项E = False Check选项F = False Else Check选项B = False End If End If End Sub Private Sub Check选项C_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项C = True Then Check选项A = False Check选项B = False ' Check选项C = False Check选项D = False Check选项E = False Check选项F = False Else Check选项C = False End If End If End Sub Private Sub Check选项D_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项D = True Then Check选项A = False Check选项B = False Check选项C = False ' Check选项D = False Check选项E = False Check选项F = False Else Check选项D = False End If End If End Sub Private Sub Check选项E_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项E = True Then Check选项A = False Check选项B = False Check选项C = False Check选项D = False ' Check选项E = False Check选项F = False Else Check选项E = False End If End If End Sub Private Sub Check选项F_AfterUpdate() If Me.题目类型 = "单选题" Then If Check选项F = True Then Me.答题.Value = "F" Check选项A = False Check选项B = False Check选项C = False Check选项D = False Check选项E = False ' Check选项F = False Else Check选项F = False End If End If End Sub 问卷管理

Private Sub Command更新_Click() If MsgBox("是否更新问卷记录：" & wj_name, vbYesNo) <> vbYes Then Exit Sub End If If 问卷名称2 = "" Or IsNull(问卷名称2) = True Then MsgBox "问卷名称值为空！" Exit Sub End If If wj_name = "" Then MsgBox "请先选择需要管理的问卷！" Exit Sub End If If wj_name <> Me.问卷名称2 Then If Nz(DCount("问卷名称", "问卷表", "问卷名称='" & Me.问卷名称2 & "'"), 0) > 0 Then MsgBox "该问卷名称已存在！" Exit Sub End If End If '---------------------------------------- Dim update_sql As String update_sql = "Select * From 问卷表 where 问卷名称='" & wj_name & "'" Dim update_rs As DAO.Recordset Set update_rs = CurrentDb.OpenRecordset(update_sql, dbOpenDynaset) With update_rs .Edit !问卷名称.Value = 问卷名称2.Value !问卷内容.Value = 问卷内容2.Value !问卷日期.Value = 问卷日期2.Value !备注.Value = 备注2.Value .Update .Close End With Set update_rs = Nothing MsgBox "更新完成" Me.数据表子窗体.Requery End Sub Private Sub Command清空_Click() 问卷名称.Value = "" 问卷内容.Value = "" 问卷日期.Value = "" 备注.Value = "" End Sub Private Sub Command删除_Click() If MsgBox("是否删除问卷记录：" & wj_name, vbYesNo) <> vbYes Then Exit Sub End If If wj_name = "" Then MsgBox "请先选择需要删除的问卷！" Exit Sub End If DoCmd.SetWarnings (False) Dim del_sql As String del_sql = "Delete From 问卷表 Where 问卷名称='" & wj_name & "'" DoCmd.RunSQL del_sql MsgBox "删除完成" Me.数据表子窗体.Requery wj_name = "" 问卷名称2.Value = "" 问卷内容2.Value = "" 问卷日期2.Value = "" 备注2.Value = "" End Sub Private Sub Command添加_Click() If 问卷名称 = "" Or IsNull(问卷名称) = True Then MsgBox "问卷名称值为空！" Exit Sub End If If Nz(DCount("问卷名称", "问卷表", "问卷名称='" & Me.问卷名称 & "'"), 0) > 0 Then MsgBox "该问卷名称已存在！" Exit Sub End If Dim add_rs As DAO.Recordset Set add_rs = CurrentDb.OpenRecordset("问卷表", dbOpenTable) With add_rs .AddNew !问卷名称.Value = 问卷名称.Value !问卷内容.Value = 问卷内容.Value !问卷日期.Value = 问卷日期.Value !备注.Value = 备注.Value .Update .Close End With Set add_rs = Nothing MsgBox "添加完成" Me.数据表子窗体.Requery End Sub Private Sub Form_Close() On Error Resume Next Forms("系统主页").问卷列表.Requery End Sub Private Sub 问卷日期_DblClick(Cancel As Integer) Me.问卷日期 = Date End Sub 题目管理

Private Sub Command选择问卷_Click() If Me.问卷列表 <> "" Then Me.Filter = "问卷名称='" & Me.问卷列表 & "'" Me.FilterOn = True Else MsgBox "请选择问卷" Exit Sub End If End Sub 问卷选项统计

Private Sub Command导出_Click() 'On Error GoTo 导出失败 If Me.问卷名称 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If '------------------------------------------------清空表数据 DoCmd.SetWarnings (False) Dim del_sql As String del_sql = "Delete From 导出问卷选项统计表" DoCmd.RunSQL del_sql '------------------------------------------------------------------ Dim dflink_rs As DAO.Recordset Dim dflink_sql As String dflink_sql = "SELECT * FROM 问卷选项统计查询 " & " Where 问卷名称='" & Me.问卷名称 & "' order by 序号 ASC" Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset) With dflink_rs Dim add_rs As DAO.Recordset Set add_rs = CurrentDb.OpenRecordset("导出问卷选项统计表", dbOpenTable) Do While .EOF = False add_rs.AddNew add_rs!问卷名称.Value = !问卷名称.Value add_rs!序号.Value = !序号.Value add_rs!题目.Value = !题目.Value add_rs!题目类型.Value = !题目类型.Value add_rs!选项A.Value = !选项A.Value add_rs!选项B.Value = !选项B.Value add_rs!选项C.Value = !选项C.Value add_rs!选项D.Value = !选项D.Value add_rs!选项E.Value = !选项E.Value add_rs!选项F.Value = !选项F.Value add_rs!答题数量.Value = !答题数量.Value add_rs!选项A数量.Value = !选项A数量.Value add_rs!选项B数量.Value = !选项B数量.Value add_rs!选项C数量.Value = !选项C数量.Value add_rs!选项D数量.Value = !选项D数量.Value add_rs!选项E数量.Value = !选项E数量.Value add_rs!选项F数量.Value = !选项F数量.Value add_rs!选项A比例.Value = !选项A比例.Value add_rs!选项B比例.Value = !选项B比例.Value add_rs!选项C比例.Value = !选项C比例.Value add_rs!选项D比例.Value = !选项D比例.Value add_rs!选项E比例.Value = !选项E比例.Value add_rs!选项F比例.Value = !选项F比例.Value add_rs.Update .MoveNext Loop End With add_rs.Close Set add_rs = Nothing dflink_rs.Close Set dflink_rs = Nothing Call 导出查询表结果("导出问卷选项统计表") del_sql = "Delete From 导出问卷选项统计表" DoCmd.RunSQL del_sql Exit Sub 导出失败: MsgBox Err.Description End Sub Private Sub Command选择问卷_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 问卷表 Where 问卷名称='" & Me.问卷列表 & "'" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then 问卷名称.Value = search_rs!问卷名称.Value 问卷内容.Value = search_rs!问卷内容.Value 问卷日期.Value = search_rs!问卷日期.Value 备注.Value = search_rs!备注.Value End If search_rs.Close Set search_rs = Nothing '筛选数据表子窗体 Me.数据表子窗体.SourceObject = "问卷选项统计查询数据表" Me.数据表子窗体.Form.Filter = "问卷名称='" & Me.问卷名称 & "'" Me.数据表子窗体.Form.FilterOn = True End Sub Private Sub Form_Load() Me.数据表子窗体.SourceObject = "" End Sub 问卷填空题统计

Private Sub Command导出_Click() 'On Error GoTo 导出失败 If Me.问卷名称 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If '------------------------------------------------清空表数据 DoCmd.SetWarnings (False) Dim del_sql As String del_sql = "Delete From 导出问卷填空题统计表" DoCmd.RunSQL del_sql '------------------------------------------------------------------ Dim dflink_rs As DAO.Recordset Dim dflink_sql As String dflink_sql = "SELECT * FROM 问卷填空题统计查询 " & " Where 问卷名称='" & Me.问卷名称 & "' order by 序号 ASC" Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset) With dflink_rs Dim add_rs As DAO.Recordset Set add_rs = CurrentDb.OpenRecordset("导出问卷填空题统计表", dbOpenTable) Do While .EOF = False add_rs.AddNew add_rs!问卷名称.Value = !问卷名称.Value add_rs!序号.Value = !序号.Value add_rs!题目.Value = !题目.Value add_rs!题目类型.Value = !题目类型.Value add_rs!答题.Value = !答题.Value add_rs.Update .MoveNext Loop End With add_rs.Close Set add_rs = Nothing dflink_rs.Close Set dflink_rs = Nothing Call 导出查询表结果("导出问卷填空题统计表") del_sql = "Delete From 导出问卷填空题统计表" DoCmd.RunSQL del_sql Exit Sub 导出失败: MsgBox Err.Description End Sub Private Sub Command选择问卷_Click() If Me.问卷列表 <> "" Then Else MsgBox "请选择问卷" Exit Sub End If Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 问卷表 Where 问卷名称='" & Me.问卷列表 & "'" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then 问卷名称.Value = search_rs!问卷名称.Value 问卷内容.Value = search_rs!问卷内容.Value 问卷日期.Value = search_rs!问卷日期.Value 备注.Value = search_rs!备注.Value End If search_rs.Close Set search_rs = Nothing '筛选数据表子窗体 Me.数据表子窗体.SourceObject = "问卷填空题统计查询数据表" Me.数据表子窗体.Form.Filter = "问卷名称='" & Me.问卷名称 & "'" Me.数据表子窗体.Form.FilterOn = True End Sub Private Sub Form_Load() Me.数据表子窗体.SourceObject = "" End Sub 答题题目数据表

Private Sub 序号_DblClick(Cancel As Integer) Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 题目表 Where 题目ID=" & Me.题目ID Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then Forms("系统主页").题目ID.Value = search_rs!题目ID.Value Forms("系统主页").问卷名称.Value = search_rs!问卷名称.Value Forms("系统主页").序号.Value = search_rs!序号.Value Forms("系统主页").题目.Value = search_rs!题目.Value Forms("系统主页").题目类型.Value = search_rs!题目类型.Value Forms("系统主页").选项A.Value = search_rs!选项A.Value Forms("系统主页").选项B.Value = search_rs!选项B.Value Forms("系统主页").选项C.Value = search_rs!选项C.Value Forms("系统主页").选项D.Value = search_rs!选项D.Value Forms("系统主页").选项E.Value = search_rs!选项E.Value Forms("系统主页").选项F.Value = search_rs!选项F.Value '题目图片.Value = search_rs!题目图片.Value Call 答题控件设置 Call 筛选答题记录(search_rs!题目ID.Value) Call 显示题目图片(Me.题目ID) End If search_rs.Close Set search_rs = Nothing End Sub 题目数据表

Private Sub 题目ID_DblClick(Cancel As Integer) Forms("题目管理").题目子窗体.Form.Filter = "题目ID=" & Me.题目ID Forms("题目管理").题目子窗体.Form.FilterOn = True End Sub 问卷数据表

Private Sub 问卷名称_DblClick(Cancel As Integer) Dim search_rs As DAO.Recordset Dim search_sql As String search_sql = "Select * From 问卷表 Where 问卷名称='" & Me.问卷名称 & "'" Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset) If search_rs.EOF = False Then wj_name = search_rs!问卷名称.Value Forms("问卷管理").问卷名称2.Value = search_rs!问卷名称.Value Forms("问卷管理").问卷内容2.Value = search_rs!问卷内容.Value Forms("问卷管理").问卷日期2.Value = search_rs!问卷日期.Value Forms("问卷管理").备注2.Value = search_rs!备注.Value End If search_rs.Close Set search_rs = Nothing End Sub 模块

Public wj_name As String Public Sub 答题控件设置() If Forms("系统主页").题目类型 = "单选题" Or Forms("系统主页").题目类型 = "多选题" Then Forms("系统主页").答题.Visible = False If Forms("系统主页").选项A <> "" Then Forms("系统主页").选项A.Visible = True Forms("系统主页").Check选项A.Visible = True Else Forms("系统主页").选项A.Visible = False Forms("系统主页").Check选项A.Visible = False End If If Forms("系统主页").选项B <> "" Then Forms("系统主页").选项B.Visible = True Forms("系统主页").Check选项B.Visible = True Else Forms("系统主页").选项B.Visible = False Forms("系统主页").Check选项B.Visible = False End If If Forms("系统主页").选项C <> "" Then Forms("系统主页").选项C.Visible = True Forms("系统主页").Check选项C.Visible = True Else Forms("系统主页").选项C.Visible = False Forms("系统主页").Check选项C.Visible = False End If If Forms("系统主页").选项D <> "" Then Forms("系统主页").选项D.Visible = True Forms("系统主页").Check选项D.Visible = True Else Forms("系统主页").选项D.Visible = False Forms("系统主页").Check选项D.Visible = False End If If Forms("系统主页").选项E <> "" Then Forms("系统主页").选项E.Visible = True Forms("系统主页").Check选项E.Visible = True Else Forms("系统主页").选项E.Visible = False Forms("系统主页").Check选项E.Visible = False End If If Forms("系统主页").选项F <> "" Then Forms("系统主页").选项F.Visible = True Forms("系统主页").Check选项F.Visible = True Else Forms("系统主页").选项F.Visible = False Forms("系统主页").Check选项F.Visible = False End If End If If Forms("系统主页").题目类型 = "填空题" Then Forms("系统主页").答题.Visible = True Forms("系统主页").选项A.Visible = False Forms("系统主页").Check选项A.Visible = False Forms("系统主页").选项B.Visible = False Forms("系统主页").Check选项B.Visible = False Forms("系统主页").选项C.Visible = False Forms("系统主页").Check选项C.Visible = False Forms("系统主页").选项D.Visible = False Forms("系统主页").Check选项D.Visible = False Forms("系统主页").选项E.Visible = False Forms("系统主页").Check选项E.Visible = False Forms("系统主页").选项F.Visible = False Forms("系统主页").Check选项F.Visible = False End If Forms("系统主页").答题.Value = "" Forms("系统主页").Check选项A.Value = False Forms("系统主页").Check选项B.Value = False Forms("系统主页").Check选项C.Value = False Forms("系统主页").Check选项D.Value = False Forms("系统主页").Check选项E.Value = False Forms("系统主页").Check选项F.Value = False End Sub Sub 筛选答题记录(ByVal tmid As Long) Forms("系统主页").答题记录子窗体.Form.Filter = "题目ID=" & tmid Forms("系统主页").答题记录子窗体.Form.FilterOn = True Forms("系统主页").答题记录子窗体.Form.OrderBy = "答题ID DESC" Forms("系统主页").答题记录子窗体.Form.OrderByOn = True End Sub Public Sub 导出查询表结果(ByVal tablename As String) On Error GoTo 导出查询_Err DoCmd.OutputTo acOutputTable, tablename, "", "", False, "", , acExportQualityPrint 导出查询_Exit: Exit Sub 导出查询_Err: Resume 导出查询_Exit End Sub Sub 显示题目图片(ByVal tmid As Long) Forms("系统主页").图片子窗体.Form.Filter = "题目ID=" & tmid Forms("系统主页").图片子窗体.Form.FilterOn = True End Sub

如果需要开源版原文件可访问同名↓