?? modquestion.bas
字號:
Dim DScoreStr As String '保存成績的分數字符串
Dim KSDaAnStr As String '保存成績表的考生答案字符串
Dim OneDaAn As String '保存考生做的一道題的答案
Dim TempArr() As String '用于產生臨時數組
sql = "select test.title,score.danxuan,score.danxuanid,score.danxuans"
sql = sql + ",score.duoxuan,score.duoxuanid,score.duoxuans"
sql = sql + ",test.danxuan,test.danxuans,test.duoxuan,test.duoxuans"
sql = sql + ",test.tiankong,test.tiankongs,test.panduan,test.panduans,test.wenda,test.wendas"
sql = sql + ",test.zuowen,test.zuowens from score,test where score.testid=test.id and score.id=" & ID
adoRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
Title = adoRs.Fields(0).Value
TempStr = "<p align=center><b><font face='楷體_GB2312' size=5>" + Title + "</font></b></p><hr>" + vbCrLf
TempStr = TempStr + "<div align=center><table border=0 width=94% cellpadding=2><TR><TD>" + vbCrLf
'單選題
If adoRs.Fields(2).Value <> "" Then
'查詢
sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRs.Fields(2).Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
XuanZeStr = XuanZeStr + "<br><FONT size=2 COLOR=#FF0000>一、單選題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoRs.Fields(2).Value
TestIDStr = adoRs.Fields(7).Value
TMScoreStr = adoRs.Fields(8).Value
DScoreStr = adoRs.Fields(3).Value
KSDaAnStr = adoRs.Fields(1).Value
Do While Not adoSJRs.EOF
Number = Number + 1
XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT>" + vbCrLf
XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF><ul TYPE=A>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze1").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze2").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze3").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze4").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "</ul></font>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "/", adoSJRs.Fields("id").Value)
If adoSJRs.Fields("daan").Value = OneDaAn Then
XuanZeStr = XuanZeStr + "<font color=#ff0000>正確！</font>" + "標準答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
Else
XuanZeStr = XuanZeStr + "<font color=#ff0000>錯誤！</font>" + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font>" + " 標準答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
End If
XuanZeStr = XuanZeStr + "你的得分：<font color=#ff0000>" + GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分</font><br>" + vbCrLf
adoSJRs.MoveNext
Loop
End If
'多選題
adoSJRs.Close
If adoRs.Fields(5).Value <> "" Then
'查詢
sql = "select id,wenti,xuanze1,xuanze2,xuanze3,xuanze4,daan from question where id in (" + adoRs.Fields(5).Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
XuanZeStr = XuanZeStr + "<br><FONT size=2 COLOR=#FF0000>二、多選題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoRs.Fields(5).Value
TestIDStr = adoRs.Fields(9).Value
TMScoreStr = adoRs.Fields(10).Value
DScoreStr = adoRs.Fields(6).Value
KSDaAnStr = adoRs.Fields(4).Value
Do While Not adoSJRs.EOF
Number = Number + 1
XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT>" + vbCrLf
XuanZeStr = XuanZeStr + "<FONT size=2 COLOR=#0000FF><ul TYPE=A>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze1").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze2").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze3").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "<li>" + adoSJRs.Fields("xuanze4").Value + "</li>" + vbCrLf
XuanZeStr = XuanZeStr + "</ul></font>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "/", adoSJRs.Fields("id").Value)
If adoSJRs.Fields("daan").Value = OneDaAn Then
XuanZeStr = XuanZeStr + "<font color=#ff0000>正確！</font>" + "標準答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
Else
XuanZeStr = XuanZeStr + "<font color=#ff0000>錯誤！</font>" + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font>" + " 標準答案：" + "<font color=#ff0000>" + adoSJRs.Fields("daan").Value + "</font><br>" + vbCrLf
End If
XuanZeStr = XuanZeStr + "你的得分：<font color=#ff0000>" + GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分</font><br>" + vbCrLf
adoSJRs.MoveNext
Loop
End If
'填空題
adoSJRs.Close
sql = "select * from scoreTK where id=" & ID
'打開成績表里的填空題
adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
If adoTempRs.Fields("tiankongid").Value <> "" Then
'查詢
sql = "select id,wenti,daan from questionTK where id in (" + adoTempRs.Fields("tiankongid").Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
TianKongStr = TianKongStr + "<br><FONT size=2 COLOR=#FF0000>三、填空題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoTempRs.Fields("TianKongID").Value
TestIDStr = adoRs.Fields(11).Value
TMScoreStr = adoRs.Fields(12).Value
DScoreStr = adoTempRs.Fields("tiankongs").Value
KSDaAnStr = adoTempRs.Fields("tiankong").Value
Do While Not adoSJRs.EOF
Number = Number + 1
TianKongStr = TianKongStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
TempArr = Split(adoSJRs.Fields("daan").Value, "▲▲")
OneDaAn = ""
For i = 0 To UBound(TempArr)
OneDaAn = OneDaAn + "<U>" + TempArr(i) + "</U>" + "、"
Next i
OneDaAn = Left(OneDaAn, Len(OneDaAn) - 1)
TianKongStr = TianKongStr + "參考答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
TempArr = Split(OneDaAn, "▲▲")
OneDaAn = ""
For i = 0 To UBound(TempArr)
OneDaAn = OneDaAn + "<U>" + TempArr(i) + "</U>" + "、"
Next i
TianKongStr = TianKongStr + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
If OneDaAn = "" Then
TianKongStr = TianKongStr + "<font color=#bb88cc><這道題還沒判！></font><br>" + vbCrLf
Else
TianKongStr = TianKongStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
End If
adoSJRs.MoveNext
Loop
End If
'判斷題
adoSJRs.Close
adoTempRs.Close
sql = "select * from scorePD where id=" & ID
'打開成績表里的判斷題
adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
If adoTempRs.Fields("panduanid").Value <> "" Then
'查詢
sql = "select id,wenti,daan from questionPD where id in (" + adoTempRs.Fields("panduanid").Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
PanDuanStr = PanDuanStr + "<br><FONT size=2 COLOR=#FF0000>四、判斷題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoTempRs.Fields("panduanID").Value
TestIDStr = adoRs.Fields(13).Value
TMScoreStr = adoRs.Fields(14).Value
DScoreStr = adoTempRs.Fields("panduans").Value
KSDaAnStr = adoTempRs.Fields("panduan").Value
Do While Not adoSJRs.EOF
Number = Number + 1
PanDuanStr = PanDuanStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
If adoSJRs.Fields("daan").Value = "T" Then
OneDaAn = "對"
Else
OneDaAn = "錯"
End If
PanDuanStr = PanDuanStr + "參考答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
'取得考生答案
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", ",", adoSJRs.Fields("id").Value)
If OneDaAn = "" Then
OneDaAn = "這道題你沒答"
ElseIf OneDaAn = "T" Then
OneDaAn = "對"
Else
OneDaAn = "錯"
End If
PanDuanStr = PanDuanStr + "您的答案：" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
PanDuanStr = PanDuanStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
adoSJRs.MoveNext
Loop
End If
'問答題
adoSJRs.Close
adoTempRs.Close
sql = "select * from scoreWD where id=" & ID
'打開成績表里的填空題
adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
If adoTempRs.Fields("wendaid").Value <> "" Then
'查詢
sql = "select id,wenti,daan from questionWD where id in (" + adoTempRs.Fields("wendaid").Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
WenDaStr = WenDaStr + "<br><FONT size=2 COLOR=#FF0000>五、問答題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoTempRs.Fields("wendaID").Value
TestIDStr = adoRs.Fields(15).Value
TMScoreStr = adoRs.Fields(16).Value
DScoreStr = adoTempRs.Fields("wendas").Value
KSDaAnStr = adoTempRs.Fields("wenda").Value
Do While Not adoSJRs.EOF
Number = Number + 1
WenDaStr = WenDaStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
OneDaAn = adoSJRs.Fields("daan").Value
WenDaStr = WenDaStr + "參考答案：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
WenDaStr = WenDaStr + "您的答案：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
If OneDaAn = "" Then
WenDaStr = WenDaStr + "<font color=#bb88cc><這道題還沒判！></font><br>" + vbCrLf
Else
WenDaStr = WenDaStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
End If
adoSJRs.MoveNext
Loop
End If
'作文題
adoSJRs.Close
adoTempRs.Close
sql = "select * from scoreZW where id=" & ID
'打開成績表里的填空題
adoTempRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
If adoTempRs.Fields("zuowenid").Value <> "" Then
'查詢
sql = "select id,wenti,daan from questionZW where id in (" + adoTempRs.Fields("zuowenid").Value + ")"
adoSJRs.Open sql, adoCn, adOpenStatic, adLockOptimistic
'開始產生字符串
ZuoWenStr = ZuoWenStr + "<br><FONT size=2 COLOR=#FF0000>六、作文題</FONT><br>" + vbCrLf
Number = 0
'付給字符串
ScoreIDstr = adoTempRs.Fields("zuowenID").Value
TestIDStr = adoRs.Fields(17).Value
TMScoreStr = adoRs.Fields(18).Value
DScoreStr = adoTempRs.Fields("zuowens").Value
KSDaAnStr = adoTempRs.Fields("zuowen").Value
Do While Not adoSJRs.EOF
Number = Number + 1
ZuoWenStr = ZuoWenStr + "<FONT size=2 COLOR=#0000FF>" + str(Number) + "、" + adoSJRs.Fields("wenti") + "(" + GetNeedByID(TestIDStr, TMScoreStr, ",", ",", adoSJRs.Fields("id").Value) + "分)</FONT><br>" + vbCrLf
OneDaAn = adoSJRs.Fields("daan").Value
ZuoWenStr = ZuoWenStr + "評分標準：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, KSDaAnStr, ",", "▼▼", adoSJRs.Fields("id").Value)
ZuoWenStr = ZuoWenStr + "您的作文：<br>" + "<font color=#ff0000>" + OneDaAn + "</font><br>" + vbCrLf
OneDaAn = GetNeedByID(ScoreIDstr, DScoreStr, ",", ",", adoSJRs.Fields("id").Value)
If OneDaAn = "" Then
ZuoWenStr = ZuoWenStr + "<font color=#bb88cc><這道題還沒判！></font><br>" + vbCrLf
Else
ZuoWenStr = ZuoWenStr + "你的得分：<font color=#ff0000>" + OneDaAn + "分</font><br>" + vbCrLf
End If
adoSJRs.MoveNext
Loop
End If
ZuoWenStr = ZuoWenStr + "</TD></TR></table></div>" + vbCrLf
'釋放
Set adoRs = Nothing
Set adoSJRs = Nothing
Set adoTempRs = Nothing
'生成文件
Open FileName For Output As #1
Print #1, TempStr + XuanZeStr + TianKongStr + PanDuanStr + WenDaStr + ZuoWenStr
Close #1
End Sub
'把時間換成秒的函數
Function Time2Sec(ByVal TimeStr As String) As Long
Dim CountS As Long
Dim strArr() As String
strArr = Split(TimeStr, ":")
CountS = Val(strArr(0)) * 3600 + Val(strArr(1)) * 60
Time2Sec = CountS
End Function
'把秒轉化成時間的函數
Function Sec2Time(ByVal Sec As Long) As String
Dim TempStr As String
Dim TimeStr As String
TempStr = Trim(str(Sec \ 3600))
TimeStr = TempStr + ":"
TempStr = Trim(str((Sec Mod 3600) \ 60))
TimeStr = TimeStr + TempStr + ":"
TempStr = Trim(str((Sec Mod 3600) Mod 60))
Sec2Time = TimeStr + TempStr
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -