access二级编程实例

access⼆级编程实例
1．编写添加新课程的⼩程序
Private Sub Command1_Click()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Dim strSQL As String
Set rs = New ADODB.Recordset
strSQL = "select * from course" '本⾏需要补充代码rs.Open strSQL, CurrentProject.Connection, 2, 2 '本⾏需要补充代码If Not rs.EOF() Then
rs.AddNew
rs("课程编号") = Text1.Value
rs("课程名称") = Text2.Value
rs("学时") = Text3.Value
rs("学分") = Text4.Value '本⾏需要补充代码rs.Update
End If
rs.Close
Set rs = Nothing
End Sub
2.编写显⽰⽇期的⼩程序
Private Sub Command1_Click()
''' 不得删除本⾏注释
Txtdate.V alue = Date
End Sub
3.编写⽐较⼤⼩的⼩程序
Private Sub Command1_Click()
''' 不得删除本⾏注释
If Text1.Value > Text2.V alue Then
Label1.Caption = "a>b"
ElseIf Text1.Value = Text2.V alue Then
Label1.Caption = "a=b"
ElseIf Text1.Value < Text2.V alue Then
Label1.Caption = "a
End If
4.编写等级评定的⼩程序
Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset '本⾏需补充代码rs.Open "select * from Stu", CurrentProject.Connection, 2, 2 Do While Not rs.EOF '本⾏需补充代码
Select Case rs("综合分")
Case Is >= 90
rs("等级") = "优秀"
Case Is >= 80
rs("等级") = "良好" '本⾏需补充代码
Case Is >= 70
rs("等级") = "中等"
Case Is >= 60
rs("等级") = "及格"
Case Else
rs("等级") = "不及格"
End Select
rs.Update
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
AFT.Form.RecordSource = "select * from Stu"
End Sub
5.编写选择呈现的⼩程序
Private Sub List0_Click()
''' 不得删除本⾏注释
Text1.Value = List0.Value
End Sub
6.求奇数的和⼩程序
Private Sub Command1_Click()
''' 不得删除本⾏注释
sum = 0
For n = 1 To 100 Step 2
sum = sum + n
Next
Text1.Value = sum
End Sub
7.组合框选择相应选项⼩程序
Private Sub Combo1_Change()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Dim strSQL As String
Set rs = New ADODB.Recordset
strSQL = "select * from player where 组别='" & /doc/35b59a2ebb68a98271fefa6b.html bo1 & "'" '本⾏需要补充代码，实现构造SQL语句
rs.Open strSQL, CurrentProject.Connection, 2, 2
For i = List1.ListCount - 1 To 0 Step -1
List1.RemoveItem (i)
Next i
Do While Not rs.EOF() '本⾏需补充代码，设置循环终⽌条件
List1.AddItem rs("姓名")
rs.MoveNext '本⾏需补充代码，实现移到下⼀条记录
Loop
rs.Close
Set rs = Nothing
End Sub
8.组合框选择⼩程序编写
Private Sub ComboFont_Change()
''' 不得删除本⾏注释
If ComboFont.Value = "宋体" Then Txtgame.FontName = "宋体"
If ComboFont.Value = "⿊体" Then Txtgame.FontName = "⿊体"
End Sub
9.判断奇偶的⼩程序编写
Private Sub Command1_Click()
''' 不得删除本⾏注释
Dim x As Integer, y As Single
x = Int(Text1.Value)
y = Text1.Value
If y >= 0 And x = y And (y Mod 2 = 0) Then
Label1.Caption = y & "是偶数"
ElseIf y >= 0 And x = y And (y Mod 2 = 1) Then
Label1.Caption = y & "是奇数"
Else
Label1.Caption = "请输⼊⼀个⾃然数"
End If
End Sub
10.选择结果应⽤程序
Private Sub Combo1_Change()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset '本⾏需补充代码,初始化⼀个Recordset对象Dim sqlstr As String
sqlstr = "select * from score where 课程名称='" & /doc/35b59a2ebb68a98271fefa6b.html bo1 & "'" rs.Open sqlstr, CurrentProject.Connection, 2, 2 '本⾏需补充代码,和当前数据库创建连接
n = 0
x = 0
y = 0
Do While Not rs.EOF()
n = n + 1
If rs("成绩") >= 60 Then
x = x + 1
Else
y = y + 1
End If
rs.MoveNext
Loop
Me.Text1.Value = n '本⾏需补充代码,将参加⼈数显⽰在⽂本框Text1中Me.Text2.Value = x
Me.Text3.Value = y
rs.Close
Set rs = Nothing
End Sub
11.学⽣平均⾝⾼的计算⼩程序
Private Sub Command1_Click()
Dim H_Avg As Single
Dim Avg_rs As ADODB.Recordset
Set Avg_rs = New ADODB.Recordset '本⾏需补充代码
Avg_rs.Open "select avg(⾝⾼) as 平均⾝⾼from stu", CurrentProject.Connection, 2, 2 '本⾏需补充代码
H_Avg = Avg_rs("平均⾝⾼")
Text1.Value = H_Avg
Avg_rs.Close
Set Avg_rs = Nothing '本⾏需补充代码
End Sub
12.图书信息查询编写⼩程序
Private Sub Combo1_Change()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Dim strSQL As String
Set rs = New ADODB.Recordset
strSQL = "select * from book where 书号='" & /doc/35b59a2ebb68a98271fefa6b.html bo1 & "'" '本⾏需要补充代码
rs.Open strSQL, CurrentProject.Connection, 2, 2 '本⾏需要补充代码
If Not rs.EOF() Then
Text1 = rs("书名")
Text2 = rs("单价")
Text3 = rs("数量")
Text4 = Text2.Value * Text3.Value '本⾏需要补充代码
End If
rs.Close
Set rs = Nothing
End Sub
13.整数求和
Private Sub Command1_Click() ''' 不得删除本⾏注释
sum = 0
For i = Text1.Value To Text2.Value sum = sum + i
Next
Label1.Caption = sum
End Sub
、
14.等差数列求和程序
Private Sub Command1_Click() ''' 不得删除本⾏注释
sum = 0
For i = 1 To Text1.Value Step 1 sum = sum + i
Next
Label1.Caption = sum
End Sub
15.求累加程序
Private Sub Command1_Click() ''' 不得删除本⾏注释
n = Text1.Value
sum = 0
For i = 1 To n Step 1
sum = sum + (1 / i)
Next
Label2.Caption = sum
End Sub
Private Sub List1_Click()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Dim strSQL As String
Set rs = New ADODB.Recordset
strSQL = "select * from employee where 部门='" & Me.List1 & "'" '本⾏需要补充代码，实现构造SQL语句rs.Open strSQL, CurrentProject.Connection, 2, 2 '本⾏需要补充代码，实现打开记录集
i = 0
Do While Not rs.EOF
i = i + 1
rs.MoveNext
Loop
Label2.Caption = "⼈数：" & i
rs.Close '本⾏需要补充代码，实现关闭记录集Set rs = Nothing
End Sub
Option Compare Database
Private Sub Command1_Click()
''' 不得删改本⾏注释
Dim rs As ADODB.Recordset
Dim strSQL As String
Set rs = New ADODB.Recordset
strSQL = "select * from course" '本⾏需要补充代码rs.Open strSQL, CurrentProject.Connection, 2, 2 '本⾏需要补充代码If Not rs.EOF() Then
rs.AddNew
rs("课程编号") = Text1.Value
rs("课程名称") = Text2.Value
rs("学时") = Text3.Value
rs("学分") = Text4.Value '本⾏需要补充代码rs.Update
End If
rs.Close
Set rs = Nothing
End Sub
'#################################################
Private Function user_path_name() As String
Dim jjj As Integer
Dim kkk As Integer
Dim temp_str As String
temp_str = CurrentProject.Path
kkk = 0
jjj = Len(temp_str)
Do
If Mid$(temp_str, jjj, 1) = "\" Then kkk = kkk + 1
jjj = jjj - 1
Loop While (kkk < 2) And (jjj > 0)
user_path_name = "k:" + Mid$(temp_str, jjj + 1, Len(temp_str) - jjj)
End Function
Private Sub Form_Unload(Cancel As Integer)
Dim fso, datf
Dim user_path As String
Dim iii, jjj, nnn As Integer
Dim a_str As String
Dim recset As ADODB.Recordset
user_path = user_path_name()
'''user_path = CurrentProject.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Set datf = fso.CreateTextFile(user_path + "\acpda03.dat", True)
On Error GoTo pro_err
Text1.Value = "X0199": Text2.Value = "分⼦进化": Text3.Value = 60: Text4.Value = 3
Call Command1_Click
Set recset = New ADODB.Recordset
recset.Open "select * from Course where 课程编号='X0199'", CurrentProject.Connection, 1, 2 nnn = recset.RecordCount。