基于ACCESS制作的四则运算练习程序_access写成程序

一、制作小程序制作的目的;
为了帮助儿子练习小学数学四则运算，作者基于Microsoft 365MSO(版本2301 Build 16.0.16026.2002)64位 Access,制作了一套适用低年级小学生练习算术的小程序。制作完成后，儿子很喜欢，也的确起到了辅助学习的目的。为了给有需要的小朋友使用本程序，也为了与热爱ACCESS编程的朋友交流学习，作者把本小程序分享到了CSDN。可以在CSDN的下载资源里找到名为《加减乘除练习.accdb》的文档直接下载使用。
二、小程序的构成：
本小程序包含一个主页面，分别为凑十、凑百、二十以内加减法、一百以内加减法、乘法口诀练习这五个挑战练习页面，一个挑战成绩查询页面，每次进入挑战练习页面前会先进入相应的欢迎挑战界面。另外，为了在新的电脑上运行小程序时，清空小程序开发时测试参数的答题结果记录，本小程序包含了一个自动辨识电脑名，并自动判断并执行是否清空答题结果记录的功能模块。
三、小程序的使用方法：
在欢迎界面输入挑战者姓名，然后进入挑战页面，每次挑战10道由欢迎界面加载时随机生成的试题。答题开始后会显示挑战计时及挑战者姓名。答题方法非常简单，只需要在随机出现的需要填写答案的空格内输入答案，然后按回车键，系统会自动运行答题结果判断。若答题错误，会闪现出一个“X”，并弹出显示正确答案的提示框，按回车键后关闭提示框，系统自动进入下一道题；如果答题正确，系统会闪现一个“√”,并自动进入下一题。10道题答完后，系统会自动把答题结果登记到一个数据表中，以备查询练习的成果。同时系统会显示答题结果统计信息，包括答题用时，答对题数，答错的所有题的正确算式等信息。若10道题全部答对，会在弹出答题结果提示框的同时，发出“你真棒！”的语音信息，若没有完全答对，会发出“继续努力哦！”的鼓励语音。两个语音文件可从网上下载，分别重命名为Great.wav和Fighting.wav，并保存到C:\temp文件夹内。
四、小程序页面截图






五、代码截图
Private Sub btnCreate_Click()
On Error GoTo Err_btnCreate
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strTemp As String
Dim rsNum, i As Integer
If Me.txtNameInput = “” Then
MsgBox “请输入您的姓名”, vbInformation, “重要提示”
Me.txtNameInput.SetFocus
Exit Sub
Else
yourName = Me.txtNameInput
End If
strTemp = “乘法试题表”
rs.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rsNum = rs.RecordCount
If rs.RecordCount >= 1 Then
For i = 1 To rsNum
rs.MoveFirst
rs.Delete
rs.Update
Next i
End If
For i = 1 To 10
rs.AddNew
rs(0) = i
rs(1) = Rnd() * 8 + 1
rs(2) = Rnd() * 8 + 1
rs(3) = rs(1) * rs(2)
rs.Update
Next i
rs.Close
Set rs = Nothing
DoCmd.OpenForm “乘法口诀练习”
DoCmd.Close acForm, “乘法欢迎界面”, acSaveYes
Exit_btnCreate:
Exit Sub
Err_btnCreate:
MsgBox Err.Description
Resume Exit_btnCreate
End Sub
Private Sub btnConform_Click()
On Error GoTo Err_btnConform
Dim rowNum As Integer
Dim intTemp As Integer
Dim i As Integer
intTemp = 0
rowNum = Int(Me.ID)
If posCode = 1 Then
If InStr(Me.因数1_答, “.”) > 0 Then ‘如果在点击回车键的时候，误点了旁边的“.”建，则自动清除那个句点符号
Me.因数1_答 = Replace(Me.因数1_答, “.”, “”)
End If
DoCmd.SetWarnings False
DoCmd.RunSQL “update 乘法试题表 set [因数1_答] = '” & Me.因数1_答 & "’ where [ID]= " & rowNum
intTemp = Int(Me.因数1_题)
If Int(Me.因数1_答) = Int(Me.因数1_题) Then
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘√’ where [ID]= " & rowNum
Else
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘×’ where [ID]= " & rowNum
MsgBox "正确的答案是： " & intTemp
End If
DoCmd.SetWarnings True
ElseIf posCode = 2 Then
If InStr(Me.因数2_答, “.”) > 0 Then
Me.因数2_答 = Replace(Me.因数2_答, “.”, “”)
End If
DoCmd.SetWarnings False
DoCmd.RunSQL “update 乘法试题表 set [因数2_答] = '” & Me.因数2_答 & "’ where [ID]= " & rowNum
intTemp = Int(Me.因数2_题)
If Int(Me.因数2_答) = Int(Me.因数2_题) Then
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘√’ where [ID]= " & rowNum
Else
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘×’ where [ID]= " & rowNum
MsgBox "正确的答案是： " & intTemp
End If
DoCmd.SetWarnings True
ElseIf posCode = 3 Then
If InStr(Me.积_答, “.”) > 0 Then
Me.积_答 = Replace(Me.积_答, “.”, “”)
End If
DoCmd.SetWarnings False
DoCmd.RunSQL “update 乘法试题表 set [积_答] = '” & Me.积_答 & "’ where [ID]= " & rowNum
intTemp = Int(Me.积_题)
If Int(Me.积_答) = Int(Me.积_题) Then
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘√’ where [ID]= " & rowNum
Else
DoCmd.RunSQL "update 乘法试题表 set [答题结果] = ‘×’ where [ID]= " & rowNum
MsgBox "正确的答案是： " & intTemp
End If
DoCmd.SetWarnings True
End If
Me.答题结果.Visible = True
'Sleep 500
DoEvents
DoEvents
Me.btnNext.SetFocus
Call btnNext_Click
Exit_btnConform:
Exit Sub
Err_btnConform:
MsgBox Err.Description
Resume Exit_btnConform
End Sub

Private Sub btnNext_Click()
On Error GoTo Err_btnNext
Dim curID As Integer
Dim rsNum As Integer
Dim tempPosCode As Integer
Me.答题结果.Visible = False
If Me.ID < 10 Then
Me.ID = Me.ID + 1
curID = Int(Me.ID)
Else
Me.ID = 10
curID = Int(Me.ID) + 1
End If
rsNum = DCount(“ID”, “乘法试题表”)
If curID <= rsNum Then
DoCmd.GoToRecord , , acNext '很奇怪，如果进行单步运行代码，则运行到这行代码的时候就报错“不能在设计视图中对对象使用GoToRecord或SerchForRecord操作或方法”
Call rwItem_Change
Else
Me.TimerInterval = 0
Dim rightNum As Integer
rightNum = DCount(“ID”, “乘法试题表”, “答题结果=‘√’”)
'把答题结果等级到成绩登记表内
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strTemp As String
Dim i As Integer

    strTemp = "答题成绩记录表"
    rs.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    i = rs.RecordCount
    rs.AddNew
    If i < 1 Then
        rs(0) = 1
    Else
        rs(0) = i + 1
    End If
    rs(1) = "乘法口诀"
    rs(2) = rightNum
    rs(3) = intTimer
    rs(4) = Format(Now(), "General Date")
    rs(5) = yourName
    rs.Update
    rs.Close
    Set rs = Nothing
    '显示错题行
    Dim strWrongList As String
    Dim strFactor1 As String
    Dim strFactor2 As String
    Dim strResult As String
    Dim rs2 As ADODB.Recordset
    Set rs2 = New ADODB.Recordset
    strWrongList = ""
    strTemp = "乘法试题表"
    rs2.Open strTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    rs2.MoveFirst
    For i = 1 To 10
        If rs2("答题结果") = "×" Then
            strFactor1 = CStr(rs2(1))
            strFactor2 = CStr(rs2(2))
            strResult = CStr(rs2(3))
            strWrongList = strWrongList & Chr(13) & Chr(10) & "    " & strFactor1 & " × " & strFactor2 & " = " & strResult
                          
        End If
        If Not rs2.EOF Then rs2.MoveNext
    Next
    If Len(strWrongList) < 1 Then
        strWrongList = "0 道题目，您真棒！"
    Else
        strWrongList = strWrongList & Chr(13) & Chr(10) & "要努力哦！请多加练习，您一定可以全部挑战成功的！"
    End If
    
    rs2.Close
    Set rs2 = Nothing
    '播放语音
    Dim iRetValue As Long
    If rightNum = 10 Then
        iRetValue = sndPlaySound("C:\Users\TSS\Music\Great_051138.wav", SND_ASYNC)
    Else
        iRetValue = sndPlaySound("C:\Users\TSS\Music\Fighting_051135.wav", SND_ASYNC)
    End If
    If MsgBox("已经是最后一题了。" & Chr(13) & Chr(10) & _
              yourName & "本次挑战共用时： " & intTimer & " 秒。" & Chr(13) & Chr(10) & _
              yourName & "本次挑战共答对： " & rightNum & " 道题。" & Chr(13) & Chr(10) & _
              "您答错了：   " & strWrongList & Chr(13) & Chr(10) & _
              "若要继续挑战,请重新生成一组试题。", vbOKOnly) = vbOK Then
        DoCmd.OpenForm "乘法欢迎界面"
        DoCmd.Close acForm, "乘法口诀练习", acSaveYes
    End If
End If
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62

Exit_btnNext:
Exit Sub
Err_btnNext:
MsgBox Err.Description
Resume Exit_btnNext
End Sub