选择题库考试系统软件单机版

考试加油站

说明：本软件为VB开发，只要你将试题做成我们模板格式电子表格，即可批量导入软件，现分享如下。
具体步骤如下。
1.在电子表格模板中加入试题，试题根据答案选项多少，自动判断为单项还是多项选择
2.在题库编辑器中一键导入试题，此时生成一个数据库文件TK.MDB
3.将上面生成的数据库文件复制到客户端就可以使用了
4.3个附件需同时下载方可解压哦

这是电子表格固定格式

这是导入界面

这是成品软件界面

请到以下地址更新下载
http://club.excelhome.net/thread-1322757-1-1.html









补充内容 (2018-3-10 11:29):
最新版下载地址
http://club.excelhome.net/thread-1397357-1-1.html

考试加油站

只能导入2003格式电子表格，不能导入其它格式，以下是代码，望高人指点或修改一下

1. Private Sub Command7_Click() '题库导入
   
2. 
   
3.     On Error GoTo err1
   
4.    
   
5.    
   
6.     Dim ZJStr() As String '章节列表
   
7.     Dim ZJId() As String
   
8.    
   
9.     Dim FileStr As String
   
10.     CommonDialog1.FileName = ""
    
11.     CommonDialog1.Filter = "Excel表格文件|*.xls"
    
12.     CommonDialog1.Action = 1
    
13.    
    
14.     FileStr = CommonDialog1.FileName
    
15.    
    
16.     If FileStr = "" Then
    
17.         Exit Sub
    
18.     End If
    
19.    
    
20.    
    
21.     Label1.Caption = "正在分析章节信息，请稍后！"
    
22.    
    
23.     Dim Sql As String
    
24.     Dim MsgTxt As String
    
25.     Dim Rs_Zj As ADODB.Recordset
    
26.     Dim Rs As ADODB.Recordset
    
27.    
    
28.    
    
29.     Sql = "select * from zjinfo "
    
30.     Set Rs_Zj = ExecuteSQL(Sql, MsgTxt)
    
31.    
    
32.     If InStr(MsgTxt, "错误") Then
    
33.         MsgBox MsgTxt
    
34.         Exit Sub
    
35.     End If
    
36.    
    
37.     ReDim ZJStr(0)
    
38.     ReDim ZJId(0)
    
39.     If Rs_Zj.RecordCount > 0 Then '========================获取章节信息 如果有
    
40.    
    
41.         For i = 1 To Rs_Zj.RecordCount
    
42.             ReDim Preserve ZJStr(i)
    
43.             ReDim Preserve ZJId(i)
    
44.             
    
45.             ZJStr(i) = Rs_Zj.Fields("zjname") & ""
    
46.             ZJId(i) = Rs_Zj.Fields("zjid") & ""
    
47.             Rs_Zj.MoveNext
    
48.         Next i
    
49.         
    
50.         
    
51.     End If
    
52.    
    
53.    
    
54.     Sql = "select * from tminfo"
    
55.     Set Rs = ExecuteSQL(Sql, MsgTxt)
    
56.     If InStr(MsgTxt, "错误") Then
    
57.         MsgBox MsgTxt
    
58.         Exit Sub
    
59.     End If
    
60.    
    
61.    
    
62.    
    
63.     Dim NewApp
    
64.     Dim NewSheet
    
65.     Dim NewBook
    
66.    
    
67.     Set NewApp = New Excel.Application
    
68.     Set NewBook = NewApp.Workbooks.Open(FileStr, , , , "")
    
69.     '第一位为路径，第五位为密码
    
70.     Set NewSheet = NewBook.Worksheets(1)
    
71.    
    
72.     For i = 2 To NewSheet.Cells.Count
    
73.         
    
74.         Label1.Caption = "正在读取第" & i & 项
    
75.         DoEvents
    
76.         If Trim(NewSheet.Cells(i, 1)) = "" Then
    
77.             Exit For
    
78.         End If
    
79.         
    
80.         '先判断该章节是否已经添加
    
81.         
    
82.         For j = 1 To UBound(ZJId)
    
83.             
    
84.             If ZJStr(j) = Trim(NewSheet.Cells(i, 8)) Then
    
85.                 Exit For
    
86.             End If
    
87.         Next j
    
88.         
    
89.         If j > UBound(ZJId) Then '没有找到
    
90.             
    
91.             Rs_Zj.AddNew
    
92.             Rs_Zj.Fields("zjname") = Trim(NewSheet.Cells(i, 8))
    
93.             Rs_Zj.Update
    
94.             
    
95.             ReDim Preserve ZJStr(j)
    
96.             ReDim Preserve ZJId(j)
    
97.             
    
98.             ZJStr(j) = Trim(NewSheet.Cells(i, 8))
    
99.             ZJId(j) = Rs_Zj.Fields("zjid") & ""
    
100.         
     
101.         End If
     
102.         
     
103.         
     
104.         Rs.AddNew
     
105.         
     
106.         
     
107.         RichTextBox2.TextRTF = Trim(NewSheet.Cells(i, 1))
     
108.         Rs.Fields("TMStra") = jm(RichTextBox2.TextRTF)
     
109.         
     
110.         Dim a As String
     
111.         
     
112.         If Len(NewSheet.Cells(i, 2)) > 2 Then
     
113.             a = Left(NewSheet.Cells(i, 2), 2)
     
114.             If InStr(a, "A") Then
     
115.                 NewSheet.Cells(i, 2) = Mid(NewSheet.Cells(i, 2), 2, Len(NewSheet.Cells(i, 2)))
     
116.             End If
     
117.         End If
     
118.         
     
119.         
     
120.         If Len(NewSheet.Cells(i, 3)) > 2 Then
     
121.             a = Left(NewSheet.Cells(i, 3), 2)
     
122.             If InStr(a, "B") Then
     
123.                 NewSheet.Cells(i, 3) = Mid(NewSheet.Cells(i, 3), 2, Len(NewSheet.Cells(i, 3)))
     
124.             End If
     
125.         End If
     
126.         
     
127.         
     
128.         If Len(NewSheet.Cells(i, 4)) > 2 Then
     
129.             a = Left(NewSheet.Cells(i, 4), 2)
     
130.             If InStr(a, "C") Then
     
131.                 NewSheet.Cells(i, 4) = Mid(NewSheet.Cells(i, 4), 2, Len(NewSheet.Cells(i, 4)))
     
132.             End If
     
133.         End If
     
134.         
     
135.         
     
136.         If Len(NewSheet.Cells(i, 5)) > 2 Then
     
137.             a = Left(NewSheet.Cells(i, 5), 2)
     
138.             If InStr(a, "D") Then
     
139.                 NewSheet.Cells(i, 5) = Mid(NewSheet.Cells(i, 5), 2, Len(NewSheet.Cells(i, 5)))
     
140.             End If
     
141.         End If
     
142.         
     
143.         
     
144.         
     
145.         If Len(NewSheet.Cells(i, 6)) > 2 Then
     
146.             a = Left(NewSheet.Cells(i, 6), 2)
     
147.             If InStr(a, "E") Then
     
148.                 NewSheet.Cells(i, 6) = Mid(NewSheet.Cells(i, 6), 2, Len(NewSheet.Cells(i, 6)))
     
149.             End If
     
150.         End If
     
151.         
     
152.         
     
153.         
     
154.         
     
155.         
     
156.         
     
157.         
     
158.         
     
159.         Rs.Fields("XXA") = jm(Trim(NewSheet.Cells(i, 2)))
     
160.         Rs.Fields("XXB") = jm(Trim(NewSheet.Cells(i, 3)))
     
161.         Rs.Fields("XXC") = jm(Trim(NewSheet.Cells(i, 4)))
     
162.         Rs.Fields("XXD") = jm(Trim(NewSheet.Cells(i, 5)))
     
163.         Rs.Fields("XXE") = jm(Trim(NewSheet.Cells(i, 6)))
     
164.         Rs.Fields("ZJID") = ZJId(j)
     
165.         Rs.Fields("STJX") = jm(Trim(NewSheet.Cells(i, 9)))
     
166.         
     
167.         
     
168.         
     
169.         If Len(Trim(NewSheet.Cells(i, 7))) = "1" Then
     
170.                     
     
171.                 If Trim(UCase(NewSheet.Cells(i, 7))) = "A" Or Trim(UCase(NewSheet.Cells(i, 7))) = "B" Or Trim(UCase(NewSheet.Cells(i, 7))) = "C" Or Trim(UCase(NewSheet.Cells(i, 7))) = "D" Or Trim(UCase(NewSheet.Cells(i, 7))) = "E" Then
     
172.                     Rs.Fields("TMtype") = "单选"
     
173.                     
     
174.                     Select Case Trim(NewSheet.Cells(i, 7))
     
175.                         Case "A"
     
176.                            Rs.Fields("TMDA") = 0
     
177.                         Case "B"
     
178.                             Rs.Fields("TMDA") = 1
     
179.                         Case "C"
     
180.                             Rs.Fields("TMDA") = 2
     
181.                         Case "D"
     
182.                             Rs.Fields("TMDA") = 3
     
183.                         Case "E"
     
184.                             Rs.Fields("TMDA") = 4
     
185.                     End Select
     
186.                     
     
187.                     
     
188.                     
     
189.                 End If
     
190.                
     
191.                 If Trim(NewSheet.Cells(i, 7)) = "0" Or Trim(NewSheet.Cells(i, 7)) = "1" Then
     
192.                     Rs.Fields("TMtype") = "判断"
     
193.                     Rs.Fields("TMDA") = Trim(NewSheet.Cells(i, 7))
     
194.                     
     
195.                     
     
196.                 End If
     
197.                
     
198.             Else
     
199.                 Rs.Fields("TMtype") = "多选"
     
200.                
     
201.                 Dim DXStr As String
     
202.                
     
203.                 DXStr = ""
     
204.                     
     
205.                     If InStr(Trim(NewSheet.Cells(i, 7)), "A") Then
     
206.                         DXStr = DXStr & "0"
     
207.                     Else
     
208.                         DXStr = DXStr & "8"
     
209.                     End If
     
210.                     
     
211.                     
     
212.                     If InStr(Trim(NewSheet.Cells(i, 7)), "B") Then
     
213.                         DXStr = DXStr & "1"
     
214.                     Else
     
215.                         DXStr = DXStr & "8"
     
216.                     End If
     
217.                     
     
218.                     
     
219.                     If InStr(Trim(NewSheet.Cells(i, 7)), "C") Then
     
220.                         DXStr = DXStr & "2"
     
221.                     Else
     
222.                         DXStr = DXStr & "8"
     
223.                     End If
     
224.                     
     
225.                     
     
226.                     If InStr(Trim(NewSheet.Cells(i, 7)), "D") Then
     
227.                         DXStr = DXStr & "3"
     
228.                     Else
     
229.                         DXStr = DXStr & "8"
     
230.                     End If
     
231.                     
     
232.                     If InStr(Trim(NewSheet.Cells(i, 7)), "E") Then
     
233.                         DXStr = DXStr & "4"
     
234.                     Else
     
235.                         DXStr = DXStr & "8"
     
236.                     End If
     
237.                     
     
238.                
     
239.                
     
240.                  Rs.Fields("TMDA") = jm(DXStr)
     
241.             End If
     
242.             
     
243.             Rs.MoveNext
     
244.             
     
245.         
     
246.         
     
247.     Next i
     
248.    
     
249.     Label1.Caption = "读取完毕！共读取" & i - 2 & "个记录"
     
250.    
     
251.     Rs.MoveFirst
     
252.    
     
253.     Label1.Caption = "正在重新分配题目号码！"
     
254.    
     
255.     For i = 1 To UBound(ZJId)
     
256.         DoEvents
     
257.         Sql = "select * from tminfo where zjid=" & ZJId(i)
     
258.         Set Rs = ExecuteSQL(Sql, MsgTxt)
     
259.         Label1.Caption = "正在重新分配题目号码 ID：" & ZJId(i)
     
260.         
     
261.         If Rs.RecordCount > 0 Then
     
262.             
     
263.             
     
264.             For j = 1 To Rs.RecordCount
     
265.                 DoEvents
     
266.                 Rs.Fields("TMNum") = j
     
267.                 Rs.Update
     
268.                
     
269.                 Label1.Caption = "正在重新分配题目号码 ID：" & ZJId(i) & " 题目号码：" & j
     
270.                 Rs.MoveNext
     
271.             Next j
     
272.             
     
273.             
     
274.             
     
275.             
     
276.             
     
277.         End If
     
278.         
     
279.         
     
280.         
     
281.    
     
282.     Next i
     
283.    
     
284.    
     
285.    
     
286.    
     
287.    
     
288.    
     
289.    
     
290.    
     
291.    
     
292.     MsgBox "题目导入完毕！", vbInformation, "消息提示"
     
293.    
     
294.    
     
295.     RichTextBox1.Text = ""
     
296.     Main.add_zj
     
297.     ListView2.HideSelection = False
     
298.     ListView1.HideSelection = False
     
299.    
     
300.     If ListView2.ListItems.Count > 0 Then
     
301.    
     
302.         Call ListView2_ItemClick(ListView2.ListItems.Item(1))
     
303.     End If
     
304.    
     
305.    
     
306. err1:
     
307.     If Err.Number > 0 Then
     
308.         MsgBox Err.Description, vbCritical, "错误提示"
     
309.         Exit Sub
     
310.     End If
     
311.     END SUB

复制代码

admin3354

牛X，膜拜。

喜有此李

不错的。thanks for sharing.

nekooooooooo

这楼主真是神了，在网上看了一会就晕的不行

考试加油站

分享新版附件如下

百度不到去谷歌

考试加油站 发表于 2016-12-31 18:19
只能导入2003格式电子表格，不能导入其它格式，以下是代码，望高人指点或修改一下

工程引用的时候 不要引用03 代码里创建application的时候 用后期绑定个 就可以自动适应系统安装的版本了

考试加油站

后期绑定如何操作，不太会。

熊文来

您好，我加你QQ了  有时间通过以下 可以吗？