📄 create_form.frm
字号:
Top = 2280
Width = 735
End
Begin VB.Label Label8
Caption = "章节"
Height = 255
Left = 1320
TabIndex = 41
Top = 2280
Width = 615
End
Begin VB.Label Label7
Caption = "问答题"
Height = 255
Left = 360
TabIndex = 40
Top = 5640
Width = 1095
End
Begin VB.Label Label6
Caption = "简答题"
Height = 255
Left = 360
TabIndex = 39
Top = 5145
Width = 975
End
Begin VB.Label Label5
Caption = "解释题"
Height = 255
Left = 360
TabIndex = 38
Top = 4635
Width = 1095
End
Begin VB.Label Label4
Caption = "判断题"
Height = 255
Left = 360
TabIndex = 37
Top = 4140
Width = 615
End
Begin VB.Label Label3
Caption = "填空题"
Height = 255
Left = 360
TabIndex = 36
Top = 3645
Width = 735
End
Begin VB.Label Label2
Caption = "多选题"
Height = 255
Left = 360
TabIndex = 35
Top = 3135
Width = 735
End
Begin VB.Label Label1
Caption = "单选题"
Height = 255
Left = 360
TabIndex = 34
Top = 2640
Width = 735
End
Begin VB.Line Line1
X1 = 120
X2 = 6120
Y1 = 2040
Y2 = 2040
End
End
Begin VB.CommandButton Command2
Caption = "退出"
BeginProperty Font
Name = "黑体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3720
TabIndex = 1
Top = 6600
Width = 2415
End
Begin VB.CommandButton Command1
Caption = "生成试卷"
BeginProperty Font
Name = "黑体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 480
TabIndex = 0
Top = 6600
Width = 2055
End
End
Attribute VB_Name = "Create_Form"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call GetTable1("DXTable", "单选题", Text2.Text, Text3.Text, Text4.Text)
Call GetTable1("DuoTable", "多选题", Text5.Text, Text6.Text, Text7.Text)
Call GetTable1("TianTable", "填空题", Text8.Text, Text9.Text, Text10.Text)
Call GetTable1("PanTable", "判断题", Text11.Text, Text12.Text, Text13.Text)
Call GetTable1("JieTable", "名词解释", Text14.Text, Text15.Text, Text16.Text)
Call GetTable1("JianTable", "简答题", Text17.Text, Text18.Text, Text19.Text)
Call GetTable1("WenTable", "问答题", Text20.Text, Text21.Text, Text22.Text)
Show_Form.Show
Show_Form.Adodc1.Refresh
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Command3_Click()
If (Combo2.Text = "单选题") Then
Text2.Text = Combo1.Text
Text3.Text = Combo3.Text
Text4.Text = Text1.Text
End If
If (Combo2.Text = "多选题") Then
Text5.Text = Combo1.Text
Text6.Text = Combo3.Text
Text7.Text = Text1.Text
End If
If (Combo2.Text = "填空题") Then
Text8.Text = Combo1.Text
Text9.Text = Combo3.Text
Text10.Text = Text1.Text
End If
If (Combo2.Text = "判断题") Then
Text11.Text = Combo1.Text
Text12.Text = Combo3.Text
Text13.Text = Text1.Text
End If
If (Combo2.Text = "名词解释") Then
Text14.Text = Combo1.Text
Text15.Text = Combo3.Text
Text16.Text = Text1.Text
End If
If (Combo2.Text = "简答题") Then
Text17.Text = Combo1.Text
Text18.Text = Combo3.Text
Text19.Text = Text1.Text
End If
If (Combo2.Text = "问答题") Then
Text20.Text = Combo1.Text
Text21.Text = Combo3.Text
Text22.Text = Text1.Text
End If
Call EmpTable("DXTable")
Call EmpTable("DuoTable")
Call EmpTable("TianTable")
Call EmpTable("PanTable")
Call EmpTable("JieTable")
Call EmpTable("JianTable")
Call EmpTable("WenTable")
Call EmpTable("MyTable")
Command1.Enabled = True
End Sub
Private Sub Command4_Click()
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
Text13.Text = ""
Text14.Text = ""
Text15.Text = ""
Text16.Text = ""
Text17.Text = ""
Text18.Text = ""
Text19.Text = ""
Text20.Text = ""
Text21.Text = ""
Text22.Text = ""
End Sub
'****获得题型表
Public Sub GetTable1(TableName As String, TypeName As String, ChapterName As String, DifficultValue As String, TiShu As String)
Dim cnn1 As ADODB.Connection
Dim myRcset As ADODB.Recordset
Dim myRcsetTab As ADODB.Recordset
Dim myCommand As ADODB.Command
Dim strCnn As String
Dim RCount As Integer
Dim RRecord As Integer
Dim mySQL As String
Dim i As Integer
Dim DelCount As Integer
Set cnn1 = New ADODB.Connection
strCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\data.mdb;Persist Security Info=False"
cnn1.Open strCnn
'***********************查询条件***********************************************************************************************
DiffmySQL = "insert into " + TableName + " select * from question where Type = '" + TypeName + "' and Chapter = '" + ChapterName + "'"
ChapmySQL = "insert into " + TableName + " select * from question where Type = '" + TypeName + "' and difficult =0" '+ DiffcultValue
mySQL = "insert into " + TableName + " select * from question where Type = '" + TypeName + "' and Chapter = '" + ChapterName + "'" + " and difficult =0" '+ DiffcultValue
If DifficultValue = "所有难度" Then
mySQL = DiffmySQL
End If
If ChapterName = "所有章节" Then
mySQL = ChapmySQL
End If
Set myRcset = New ADODB.Recordset
myRcset.CursorType = adOpenKeyset
myRcset.CursorLocation = adUseClient
myRcset.LockType = adLockOptimistic
myRcset.Open mySQL, cnn1, , , adCmbText
'***********************获得随机题数************************************************************************************************
Set myRcsetTab = New ADODB.Recordset
myRcsetTab.CursorType = adOpenKeyset
myRcsetTab.CursorLocation = adUseClient
myRcsetTab.LockType = adLockOptimistic
myRcsetTab.Open TableName, cnn1, , , adCmbTable
RCount = 0
Do While Not myRcsetTab.EOF()
RCount = RCount + 1
myRcsetTab.MoveNext
Loop
DelCount = RCount - Val(TiShu)
If DelCount > 0 Then
For i = 1 To DelCount
Randomize
myRcsetTab.MoveFirst
RRecord = CInt(Int(RCount * Rnd() + 1))
myRcsetTab.Move CLng(RRecord - 1)
myRcsetTab.Delete adAffectCurrent
myRcsetTab.Update
RCount = RCount - 1
Next i
End If
'*********插入最终表*************************************************************************************************
cnn1.Execute "insert into MyTable select * from " + TableName '+ "order by type"
cnn1.Close
End Sub
'*********************清空表****************************************************************************************
Public Sub EmpTable(TableName As String)
Dim cnn1 As ADODB.Connection
Dim strCnn As String
Dim mySQL As String
Set cnn1 = New ADODB.Connection
strCnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\data.mdb;Persist Security Info=False"
cnn1.Open strCnn
mySQL = "delete from " + TableName
cnn1.Execute mySQL, , adCmdText
cnn1.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -