'code by youxi01@bbs.bathome.net
'程序名：学分认定自动完成
'更新进度：
'2008-1-17日，完成初版；
'2008-1-23日，去掉人工输入，实现全自动；
'2008-1-24日，完成自动输入初稿(期末改试卷ing...)
'/*////////////////////////初始设定//////////////////////////////////////////
Set objExcel=CreateObject("Excel.Application")           '设置excel对象；
Set fso = CreateObject("Scripting.FileSystemObject")     '设置文件对象；
Const ForReading = 1, ForWriting = 2
'--------------------表格头设置-----------------------
str0="班级：高二 "
str1=" 班       姓名："
str2="        学号："
str3="        时间：2007 —— 2008    学年"
'-----------------要填充学分的表格---------------------
Anum="6#7#10#11#14#15#18#20#22#24#26#28#29#30#40#42"
num=split(Anum,"#")     '按 # 分割
'设置错误提示信息
msgName="学生档案文件name.txt不存在!"
msgModule="学分认定模板文件Module.xls不存在!"
msgResult="注意：请设置成绩在 25-55 之间,输入55对应产生的成绩在 90-100 分"
'/*/////////////////////////主函数部分/////////////////////////////////////
'检测输入值是否为数值；
Function CheckValue(value)
CheckValue=true                    
if IsNumeric(value)<>true then CheckValue=false:exit function
if value<25 or value>55 then CheckValue=false    '数值必须在 25 -55 之间；
End Function
'循环检测输入值是否在 25-55 之间；
Function InputNum(msg)
value=inputbox(msg&" 的成绩输入有误："&mystr(2)&vbcrlf&vbcrlf&"请输入一个 25-55 的数值","输入错误")
if CheckValue(value)=false then mystr(2)=value:InputNum(msg)
InputNum=value
End Function
'检测文件是否存在；
Function CheckFile(name)
if not fso.FileExists(name) then 
   msgbox "配置文件： "& name &" 不存在",48,"出错了!"
   wscript.quit
end if
End Function
'获取文件的父文件夹；
Function GetPFolder(obj)
GetPFolder=fso.GetFile(obj).parentfolder      
if right(GetPFolder,1)="\" then GetPFolder=left(GetPFolder,len(GetPFolder)-1)
End Function
'/*/////////////////////////主程序////////////////////////////////////////
CheckFile("name.txt")       '检测配置文件：name.txt是否存在；
CheckFile("module.xls")     '检测配置文件：module.xls是否存在；
oParentFd=GetPFolder(wscript.scriptfullname)  '获取本文件的父文件夹；
'设置班级、创建对应文件夹；
ClassName=inputbox("请输入班级："&vbcrlf&vbcrlf&"注：输入数字，如：10","班级输入")
FolderName="高二 ("&ClassName&") 班学生学分认定"
if not fso.FolderExists(FolderName) then 
   fso.CreateFolder(FolderName)
else
   msgbox "文件夹："&FolderName&" 已经存在，请确认删除!",48,"学分认定--提示信息"
end if
'读取学生信息文件；
Set f = fso.OpenTextFile("name.txt", ForReading)
Do While f.AtEndOfLine <> True 
    str=f.readline                    '读文本文件的一行
    mystr=split(str," ",-1)         '按 “ ” 分割字符
    'mystr(i)依次对应姓名、学号、成绩；
    set objWorkbook=objExcel.Workbooks.Open(oParentFd&"\module.xls")  '###模板excel###
    Set objWorksheet = objWorkbook.Worksheets(2)   
    TipInfo=str0&ClassName&str1&mystr(0)&str2&mystr(1)&str3
    objWorksheet.Cells(2,1).Value=TipInfo
    if CheckValue(mystr(2))=false then mystr(2)=InputNum(mystr(0))
    
    for i=0 to 15
         Randomize                                     '初始化随机数生成器
         Res=Int((10 * Rnd-5)) + mystr(2)                       '随机数字；
         objWorksheet.Cells(10,clng(num(i))).value=Res '将随机内容填入表格；
    next
    objWorkbook.SaveAs oParentFd&"\"&FolderName&"\"&mystr(0)&".xls"
    objExcel.quit                                          '退出excel对象；
loop
f.Close
objExcel.quit
复制代码