注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

感觉每次写程序就像写首诗,只是需要静下心  

2013-07-08 17:26:11|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
       前几天改大学计算机二的电子版试卷,需要手工对120个学生的试卷,一个个的插入表格求和公式,统计分数,然后录入到excel里。本来想着写个程序搞定这事应该很简单,没想到可能是还要改试卷,又要照顾孩子,心急火燎的调试了半天也没搞出来。最后只好手工打开每个学生的试卷,搞了一遍,这事情感觉连富士康工人都不如。今天终于搞完了所有成绩,对一个对程序无比热爱的人来说,写不出程序犹如如鲠在喉,不吐不快,心情一静下来,两下子搞定。但还是觉得年纪渐增,编程能力还是在衰退啊,以前不可能需要心情这么平静才能写出来的。。。 
        只要在写程序,就会有提高,这次碰到了几个新的问题,比如word中表格合并单元格的访问,表格中隐藏回车换行符的处理,一一解决之后无比痛快,免费的享乐方式啊!
        
 打开示例(涉及试卷信息,领导不让上传)中的excel文件,运行宏getscore,程序自动遍历当前所有子文件夹,找到文件名包含试卷的word,打开,对如下的word版试卷
    感觉每次写程序就像写首诗,只是需要静下心 - wucccsk - 生活如此多姿多彩
         插入小计求和公式,登记入第二个表格,最后求出第一个表格中的总分,然后将所有分数登记入下面的excel表格:
感觉每次写程序就像写首诗,只是需要静下心 - wucccsk - 生活如此多姿多彩
 
        编程感想:第一是递归在这种文件夹遍历查文件,而且文件夹深度未知的情况下真是用的酣畅淋漓,可见大学学的每一样东西,说不定将来哪天就会用上的。第二是应该对学生极度强调调试环境和单步调试,没学会这招就等于没学会编程,但感觉这次教学生C语言的时候,虽然一直在强调,但可能不得法吧,还是没把调试方法教好。第三,好的处理方法需要定制试卷的配合,比如这次的4个大题处理,由于第二个邮件合并没有小题计分表格,所以导致不能使用循环统一处理,而是用了逐个表格处理的方式,比较麻烦。
        最后附上源代码:
Dim Find As Boolean
Dim stuindex As Integer
Dim paperpath As String

Sub getscore()
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.getfolder(ThisWorkbook.path)
stuindex = 3
For Each fr In folder.subfolders
  s1 = InStr(fr.Name, "+")
  s2 = InStr(s1 + 1, fr.Name, "+")
  ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 5).Value = Mid(fr.Name, s1 + 1, s2 - s1 - 1)
  Find = False
  getfile (fr.path)
  getdetail (paperpath)
  stuindex = stuindex + 1
Next
Set folder = Nothing
Set fso = Nothing
MsgBox "over"
End Sub

Sub getdetail(paperpath As String)
Set wdapp = CreateObject("word.application")
Set paper = wdapp.documents.Open(paperpath)
Sum = 0
paper.tables(4).Rows(2).Cells(paper.tables(4).Columns.Count).Select
wdapp.Selection.Range.Text = ""
wdapp.Selection.InsertFormula Formula:="=SUM(LEFT)", NumberFormat:=""
wdapp.Selection.Fields.Update
paper.tables(2).Rows(2).Cells(2).Range.Text = ""
paper.tables(2).Rows(2).Cells(2).Range.Text = paper.tables(4).Rows(2).Cells(paper.tables(4).Columns.Count).Range.Text
temp = mytrim(paper.tables(2).Rows(2).Cells(2).Range.Text)
Sum = Sum + CInt(temp)
ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 7).Value = CInt(temp)
temp = mytrim(paper.tables(2).Rows(2).Cells(3).Range.Text)
Sum = Sum + CInt(temp)
ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 8).Value = CInt(temp)
paper.tables(5).Rows(2).Cells(paper.tables(5).Columns.Count).Select
wdapp.Selection.Range.Text = ""
wdapp.Selection.InsertFormula Formula:="=SUM(LEFT)", NumberFormat:=""
wdapp.Selection.Fields.Update
paper.tables(2).Rows(2).Cells(4).Range.Text = ""
paper.tables(2).Rows(2).Cells(4).Range.Text = paper.tables(5).Rows(2).Cells(paper.tables(5).Columns.Count).Range.Text
temp = mytrim(paper.tables(2).Rows(2).Cells(4).Range.Text)
Sum = Sum + CInt(temp)
ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 9).Value = CInt(temp)
paper.tables(6).Rows(2).Cells(paper.tables(6).Columns.Count).Select
wdapp.Selection.Range.Text = ""
wdapp.Selection.InsertFormula Formula:="=SUM(LEFT)", NumberFormat:=""
wdapp.Selection.Fields.Update
paper.tables(2).Rows(2).Cells(5).Range.Text = ""
paper.tables(2).Rows(2).Cells(5).Range.Text = paper.tables(6).Rows(2).Cells(paper.tables(6).Columns.Count).Range.Text
temp = mytrim(paper.tables(2).Rows(2).Cells(5).Range.Text)
Sum = Sum + CInt(temp)
ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 10).Value = CInt(temp)
paper.tables(1).Columns(4).Cells(1).Range.Text = Sum
ThisWorkbook.Worksheets("《大学计算机二》期末卷面分数统计明细表").Cells(stuindex, 11).Value = Sum
paper.Save
paper.Close
wdapp.Quit
Set paper = Nothing
Set wdapp = Nothing
End Sub

Function mytrim(str As String)
If str <> "" Then
 Do Until Asc(Right(str, 1)) >= Asc(0) And Asc(Right(str, 1)) <= Asc(9)
  str = Left(str, Len(str) - 1)
  If str = "" Then Exit Do
 Loop
End If
If str = "" Then
  mytrim = "0"
 Else
  mytrim = str
End If
End Function

Function getfile(path As String)
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.getfolder(path)
For Each f In folder.Files
  If InStr(f.Name, "试卷") <> 0 And InStr(f.Name, "~$") = 0 Then
    Find = True
    paperpath = f.path
End If
Next
If Not Find Then
  For Each fr In folder.subfolders
    getfile (fr.path)
  Next
End If
Set folder = Nothing
Set fso = Nothing
End Function
 
  评论这张
 
阅读(88)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017