2011-12-30

2011-12-30
2011年12月30日
　　用vbs来操作Excel
　　最近,班主任要 做学生的 学分认定表格,一个学生一份,每个学生又学了 N(n>=15) 课,每门课还要打n个分....
　　嫌手工输入太麻烦,做此小程序,用vbs来操作excel对象，实现自动化输入...
　　仓促所作，望批评指正...
　　'code by youxi01@bbs.bathome.net
　　'2008-1-17于***第一中学
　　'/*///初始设定///
　　Dim MyStr,fso,f,j_num
　　str0="班级：高二 18 班 "
　　str1="姓名："
　　str2=" 学号：200610"
　　str3=" 时间：2007 ―― 2008 学年"
　　msg1="学生档案文件name.txt不存在!"&vbcrlf&vbcrlf&"请按照 姓名(Tab)学号 格式，将信息保存到当前目录"
　　msg2="学分认定模板文件Module.xls不存在!"&vbcrlf&vbcrlf&"请将模板文件拷贝到当前目录，并更名。"
　　'/*/以下用#隔开的数字为要填学分的位置/
　　j_num="6#7#10#11#14#15#18#20#22#24#26#28#29#30#40#42"
　　num=split(j_num,"#") '按 # 分割
　　'/*//创建excel对象///
　　Set objExcel=CreateObject("Excel.Application")
　　'/*==========打开文件对象==========================
　　Const ForReading = 1, ForWriting = 2
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　pfolder= fso.Getfile(wscript.scriptfullname).parentfolder
　　if right(pfolder,1)="\" then pfolder=left(pfolder,len(pfolder)-1)
　　'/*==========检测配置文件是否存在==================
　　if not fso.FileExists("name.txt") then msgbox msg1,48,"出错了!":Wscript.quit
　　if not fso.FileExists("module.xls") then msgbox msg2,48,"出错了!":Wscript.quit
　　if not fso.FolderExists("★学生学分认定★") then fso.CreateFolder("★学生学分认定★")
　　'/*//学生姓名和学号保存文件//
　　Set f = fso.OpenTextFile("name.txt", ForReading)
　　Do While f.AtEndOfLine True
　　str=f.readline '读文本文件的一行
　　MyStr=split(str," ",-1) '按 “ ” 分割字符
　　if Clng(MyStr(1))<10 then '如果学号数小于10#则自动在前面添加0；
　　Mystr(1)="0"&Mystr(1)
　　end if
　　str=str0&str1&MyStr(0)&str2&MyStr(1)&str3
　　if not fso.FileExists(pfolder&"\★学生学分认定★\"&Mystr(0)&".xls") then
　　En=inputbox("请设置 "&Mystr(0)&" 的成绩","学分认定")
　　if En="" then objExcel.quit:wscript.quit '如果选择了取消，就退出程序；
　　'/*/设置表格操作对象
　　set objWorkbook=objExcel.Workbooks.Open(pfolder&"\module.xls") '###模板excel###
　　Set objWorksheet = objWorkbook.Worksheets(2)
　　objWorksheet.Cells(2,1).Value=str '设置学生姓名，学号；
　　for i=0 to 15
　　Randomize '初始化随机数生成器
　　Res=Int((5 * Rnd)) + En '随机数字；
　　objWorksheet.Cells(10,clng(num(i))).value=Res '将随机内容填入表格；
　　next
　　'##########保存地点##############
　　objWorkbook.SaveAs pfolder&"\★学生学分认定★\"&Mystr(0)&".xls" '按学生名字保存xls文件；
　　else
　　msgbox Mystr(0) &" 的成绩已经存在!"
　　end if
　　objExcel.quit '退出excel对象；
　　loop
　　f.Close
　　objExcel.quit
　　复制代码