这个暑假在家我用了三天的时间编了一个“教师平时分统计软件”,这个软件的功能很多,可以在上课的时候随机抽取名单点名,可以随机点名,可以统计平时作业平时分,可以统计考勤,统计课堂表现记录等!功能相当的齐全,对老师平时工作很有帮助!
下面我就将我用的VBA的代码公布出来,当然这些代码很糟糕,但是运行软件没问题,可以供初学VBA的同学共同学习。代码可能有点长,请大家认真看!
'=========================================================================
'学生名单表的代码:
Private Sub CommandButton1_Click()
Dim zjls As Integer
Dim xuehao, xingming As String
Call jcsjb("学生名单")
zjls = tj("学生名单")
Call 清除统计数据("点名名单", 1, 5)
Call 清除统计数据("上课名单", 1, 2)
Call 清除统计数据("考勤统计", 1, 2)
Call 清除统计数据("提问历史统计", 1, 2)
Call 清除统计数据("提交作业", 1, 2)
Call 清除统计数据("作业统计", 1, 2)
Call 清除统计数据("平时分统计", 1, 2)
For i = 1 To zjls
With Worksheets("学生名单")
xuehao = Trim(.Cells(i, 1).Value)
xingming = Trim(.Cells(i, 2).Value)
End With
With Worksheets("考勤统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("提问历史统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("提交作业")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("作业统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
With Worksheets("平时分统计")
.Cells(i, 1).Value = xuehao
.Cells(i, 2).Value = xingming
End With
Next
End Sub
Private Sub CommandButton3_Click()
Dim renshu As Integer
Dim zrs As Integer
zrs = tj("学生名单") - 1
If Val(Trim(TextBox3.Text)) = 0 Or Val(Trim(TextBox3.Text)) > zrs Then
MsgBox "请输入点名的人数 " & Chr(13) & Chr(13) & Chr(13) & "人数必须大于0个小于" & zrs, vbOKOnly, "提醒"
Exit Sub
End If
Call 清除统计数据("点名名单", 1, 5)
renshu = Val(Trim(TextBox3.Text))
Call 点名(renshu)
Worksheets("点名名单").Activate
End Sub
Private Sub CommandButton5_Click()
Dim renshu As Integer
Worksheets("点名名单").Activate
Call 清除统计数据("点名名单", 1, 5)
renshu = Val(tj("学生名单")) - 1
Call 点名(renshu)
End Sub
‘======================================================================
'平时表现记录工作表的代码:
Private Sub CommandButton1_Click()
Call 平时表现
End Sub
Sub 平时表现()
Dim zjrs As Integer
Dim xingming, xuehao, contents, dj, time As String
zjrs = tj("平时表现记录")
xuehao = Trim(TextBox1.Text)
xingming = Trim(TextBox2.Text)
contents = Trim(TextBox3.Text)
If OptionButton1.Value = True Then
dj = "1′"
End If
If OptionButton2.Value = True Then
dj = "2′"
End If
If OptionButton3.Value = True Then
dj = "3′"
End If
If OptionButton4.Value = True Then
dj = "4′"
End If
If OptionButton5.Value = True Then
dj = "5′"
End If
Call rdjzf(xuehao, dj)
time = Trim(Now())
With Worksheets("平时表现记录")
.Cells(zjrs + 1, 1).Value = xuehao
.Cells(zjrs + 1, 2).Value = xingming
.Cells(zjrs + 1, 3).Value = dj
.Cells(zjrs + 1, 4).Value = time
.Cells(zjrs + 1, 5).Value = contents
End With
End Sub
Private Sub CommandButton2_Click()
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
End Sub
Private Sub TextBox1_Change()
Call dbclick
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call dbclick
End Sub
Sub dbclick()
Dim xuehao, xuehao2, xingming2 As String
Dim jlzs As Integer
If TextBox1.Text = "" Then
TextBox2.Text = ""
CommandButton1.Enabled = False
Exit Sub
End If
xuehao = Trim(TextBox1.Text)
jlzs = tj("学生名单")
For i = 2 To jlzs
With Worksheets("学生名单")
xuehao2 = Trim(.Cells(i, 1).Value)
xingming2 = .Cells(i, 2).Value
End With
If xuehao = xuehao2 Then
TextBox2.Text = xingming2
CommandButton1.Enabled = True
Exit Sub
Else:
TextBox2.Text = ""
CommandButton1.Enabled = False
End If
Next
End Sub
'================================================================
'提问历史统计工作表的代码:
Private Sub CommandButton1_Click()
Dim hdzfs, hdpjfs, hdfs, maxf, minf, sumf, avgf As Double
Dim zjls As Integer
zjls = tj("提问历史统计")
maxf = 0
minf = 100
sumt = 0
sumf = 0
avgf = 0
hdzfs = InputBox("请输入您规定的上课回答问题在平时分中的分值!", "请输入回答问题总分数", 20)
If hdzfs = "" Then
Exit Sub
End If
hdpjfs = hdpjf(hdzfs, zjls)
For i = 2 To zjls
With Worksheets("提问历史统计")
hdfs = 0
hdfs = hdfs + Val(Trim(.Cells(i, 4))) * 3 + Val(Trim(.Cells(i, 5))) * 2 + Val(Trim(.Cells(i, 6))) * 1
.Cells(i, 7).Value = Round(hdfs * hdpjfs)
sumf = sumf + .Cells(i, 7).Value
If maxf < .Cells(i, 7).Value Then
maxf = .Cells(i, 7).Value
End If
If minf > .Cells(i, 7).Value Then
minf = .Cells(i, 7).Value
End If
.Cells(i, 3).Value = Val(Trim(.Cells(i, 4))) + Val(Trim(.Cells(i, 5))) + Val(Trim(.Cells(i, 6)))
sumt = sumt + Val(Trim(.Cells(i, 3).Value))
End With
Next
avgf = Round(sumf / zjls, 4)
TextBox4.Text = sumt
TextBox5.Text = avgf
TextBox6.Text = maxf
TextBox7.Text = minf
End Sub
'===========================================================================
'点名名单工作表的代码:
Function 添加考勤统计() As Boolean
Dim xuehao, xingming, time As String
Dim dmjl, kqjl, kqls, k As Integer
Dim cd, kk, qj As Integer
k = 2
dmjl = tj("点名名单")
kqjl = tj("考勤统计")
For i = 2 To dmjl - 1
With Worksheets("点名名单")
xuehao = .Cells(i, 1).Value
End With
With Worksheets("点名名单")
cd = .Cells(i, 3).Value
kk = .Cells(i, 4).Value
qj = .Cells(i, 5).Value
If (Val(cd) + Val(kk) + Val(qj)) > 1 Then
MsgBox "学号为: " & xuehao & " 的记录有问题。请注意查看!添加数据失败" & Chr(13) & Chr(13) & _
"该生的记录为:" & Chr(13) & " 迟到: " & cd & Chr(13) & " 旷课:" & kk & Chr(13) & " 请假: " & qj, vbOKOnly, "错误提示"
添加考勤统计 = False
.Cells(i, 3).Select
Exit Function
Else: 添加考勤统计 = True
End If
End With
Next
With Worksheets("点名名单")
time = .Cells(dmjl, 2).Value
End With
kqls = tjl("考勤统计", 1)
With Worksheets("考勤统计")
.Cells(1, kqls + 1).Value = time
End With
For i = 2 To dmjl - 1
With Worksheets("点名名单")
xuehao = .Cells(i, 1).Value
xingming = .Cells(i, 2).Value
End With
Do
With Worksheets("考勤统计")
If .Cells(k, 1).Value = xuehao Then
Exit Do
End If
End With
k = k + 1
If k > kqjl Then
MsgBox "数据有错误:有两种可能,一是点名名单有错,二是考勤名单的学号有错。" & Chr(13) & "请检查该学生 " _
& xingming & " 的学号。" & Chr(13) & "核实名单表和考勤统计表该学生的学号", vbOKOnly, "检查严重错误"
Call goback(i, "点名名单", "考勤统计")
Exit Function
End If
Loop Until False
With Worksheets("点名名单")
cd = .Cells(i, 3).Value
kk = .Cells(i, 4).Value
qj = .Cells(i, 5).Value
End With
With Worksheets("考勤统计")
If cd = 1 Then
.Cells(k, 3).Value = Val(.Cells(k, 3).Value) + cd
.Cells(k, kqls + 1).Value = "●"
End If
If kk = 1 Then
.Cells(k, 4).Value = Val((.Cells(k, 4).Value)) + kk