|
楼主 |
发表于 2018-10-3 22:49
|
显示全部楼层
我越来越犯困了,原来wb.close savechanges:=false这句代码完全不需要,把其他工作簿的工作表移入代码所在工作簿时,移入后,工他工作簿的工作表并不会减少!工作簿不打开也可移动工作表!怪怪怪?滚动条无法滚动是由于窗口冻结!下一步要想办法如何定时禁用宏与恢复宏,如何删除工作簿中的VBA代码与对象等。修改后的试卷二版(固定选项可变题量)
试卷2版(固定选项 动态题量) .rar
(35.04 KB, 下载次数: 45)
Sub 获取题库()
MsgBox Space(4) & "1、本程序仅支持2003版Excel工作簿题库。" & Chr(10) & Space(4) & "2、如果你的题库是压缩文件,请先解压她,然后直接把她移动或复制至本工作簿。" & Chr(10) & Space(4) & "3、如果题库工作簿中有禁止选中某表、禁止移动某表或工作簿保护等程序代码等,可以删除,防止程序冲突出错。" & Chr(10) & Space(4) & "4、如果题库工作簿中某工作表中某单元格中的内容长度超过255,采用鼠标右键在工作表标签处“复制”单表与多表工作组方法(勾选建立副本)将不能获取255个以上字符!" & Chr(10) & Space(4) & "所以需采用“移动”的方法(不勾选建立副本),或每张表分别操作。" & Chr(10) & Space(4) & "先在本试卷工作簿""勿删""表右边插入三张新工作表并命名,再激活题库工作簿全选某表(鼠标单击行号列标交叉处)复制,粘贴至新表(鼠标单击行号列标交叉处粘贴或选择A1单元格后按回车键)。" & Chr(10) & Space(4) & "5、如要使用新题库,你可删除已获取的旧题库,也可不。" & Chr(10) & Space(4) & "6、如新旧题库都有,待考试新题库表标签名必须修改为“判断、单选与多选”,三表不分顺序。", , "特别提醒:"
ThisWorkbook.Unprotect
Dim fil As String, wb As Workbook, sh As Worksheet, n As Byte
On Error GoTo cancel
' Dim 某时 As Date
' 某时 = Now() + TimeValue("00:00:01")
' Application.OnTime 某时, "启用宏"
' Application.AutomationSecurity = msoAutomationSecurityForceDisable '打开含代码的工作簿时禁用宏
fil = Application.GetOpenFilename(filefilter:="仅支持Excel2003版,*.xls", Title:="请选择题库文件", MultiSelect:=False) '获取打开的文件名与路径
If fil = "False" Then
Exit Sub
Else
Application.ScreenUpdating = False
Set wb = GetObject(fil) '题库工作簿全称
For Each sh In wb.Worksheets
sh.Visible = True '隐藏的表格为什么必须在移动前就显示,移动后没法取消隐藏?但考试交卷后却能显示?
If sh.AutoFilterMode = True Then sh.AutoFilterMode = False
Next
wb.Worksheets.Move After:=ThisWorkbook.Worksheets("勿删") '移动全部工作表(包括隐藏的)至本工作簿某表之右
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "勿删" Then
sh.Select
Range("C2").Select
With ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.ScrollColumn = 1
.FreezePanes = True
End With
End If
Next
ThisWorkbook.Worksheets("勿删").Select
Application.ScreenUpdating = True
MsgBox "题库已导入本试卷程序所在工作簿。" & Chr(10) & "其中没用的工作表可以删除。"
MsgBox "生成试卷的要求:" & Chr(10) & Space(4) & "1、题库题型包括判断题、单选题与多选题,分别保存在三个工作表中,工作表名称分别设为“判断、单选、多选”,各表第一行为列标题;" & Chr(10) & Space(4) & "2、判断题2个以上,各列内容至少依次为“序号、题干、答案”三列以上,答案值为“对、错 或 T、F”之一。" & Chr(10) & Space(4) & "3、单选题2个以上,各列内容至少依次为“序号、题干、选项A、B、C、D、答案”七列以上,其中选项为四列,答案值为“ABCD”中之一;" & Chr(10) & Space(4) & "4、多选题2个以上,各列内容至少依次为“序号、题干、选项A、B、C、D、E、答案”八列以上,其中选项为五列,答案值为“ABCDE”中之几;" & Chr(10) & Space(4) & "5、题库各表第 J 列将被用于存放考生答案,K 列将被用于存放考生答案与标准答案的比较结果;" & Chr(10) & Space(4) & "6、请务必先清除题库中多余的空行、空格、换行符、答案值中的奇异字符等。" & Chr(10) & Space(4) & "7、请在获取题库后即参照“勿删”表提示对题库“答案”、“列顺序”与“标签名称”等作检查处理。" & Chr(10) & Space(4) & "8、生成试卷前要自己确定试题个数、考试所需时间,每类题型至少考2个。"
End If
cancel:
End Sub
Sub 启用宏()
' Application.AutomationSecurity = msoAutomationSecurityLow '某时启用宏
End Sub
补充内容 (2018-10-7 20:59):
有需要的,请下载66楼的《试卷2版、初版、题库样式》压缩文件。此致 |
|