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

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

让程序趋向完美,教案框架生成从2.0到4.0版  

2010-09-07 20:20:59|  分类: 技术 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
     程序需要不断的测试,今天一下下来经过一些同事的测试,发现了一些bug,也进行了一定的修改,到晚上,教案框架生成器已经有了4.0版。
    各版本请在http://e.ys168.com/?wucccsk 的VBA和VBS目录下下载,各个版本内都有修正说明,提示修改了哪些bug。最终我来讲一下4.0版,目前这个版本一般用用应该没有问题了。
    首先该版本增加了一个最重要的功能,就是1.0版问题最大的没办法有特别不一样的周,没办法处理补课与放假。下面我们来看看4.0版是如何解决这一问题的,针对我的另一门课“c#程序设计”(该课具体进度表见下载压缩包),第一周只有理论课,没有实验课。第六周实验课暂停,第七周周三补一次理论课,其他时间每周4学时,2学时理论在周一,2学时实验分2批,在周一和周四。其图如下:
让程序趋向完美,教案框架生成从2.0到4.0版 - wucccsk - wucccsk的博客
  注意要求放假周和补课周在“授课章节”最后一行必须注明,其前必须有*号,其后可以有放假或补课的理由。 
   这一版本会多提示一个如下的“放假和补课时间表达式框”,
让程序趋向完美,教案框架生成从2.0到4.0版 - wucccsk - wucccsk的博客
  这个表达式写法如下,依次说明第几周是特别周,然后该周具体上课是哪几天,两者之间用冒号分隔。实验课后依然用星号,不同的课次之间用逗号分隔,特别周可以有无限个。针对特别周,程序将不会采用先前的计算普通周时间的方式计算特别周。
   上述表达式说明:第一周只有周一1次理论。第六周也只有周一1次理论,第七周,周1理论,周1实验,周三补课一次理论,周四实验。刚好与我示例中的进度表规范写法一致。这样就完成了补课时间的处理。注意这里只所以写“第一周”,是因为进度表中的第一列是“第一周”,如果该列你写成了“1”,则该输入框中也要用“1”代替“第一周”。
   最后这个版本还增加了大纲视图,生成教案后,可以通过文档结构图,如下图,很方便的选择每次教案,进行后期修改。
让程序趋向完美,教案框架生成从2.0到4.0版 - wucccsk - wucccsk的博客
    好的,希望大家用的愉快,最后附上vbs源代码清单:
 
  Dim ja, jdb, bh, wordapp, fso, tempf, strpath, sz, dz, kx, bzysy, tbz, tbzts(), tbzxb, skzj
  bkname = InputBox("输入进度表文件名", , "教学进度表")
  rqbds = Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日;1,1*,4*"
  rqbds = InputBox("请输入日期生成表达式:", , rqbds)
  sz = Split(rqbds, ";")
  rq = sz(0)
  tbzbds = InputBox("请输入放假或补课的周数及上课时间表达式(如果全无则为空,实验课加*号):", , "第一周:1;第六周:1;第七周:1,1*,3,4*")
  If tbzbds <> "" Then
     tbz = Split(tbzbds, ";")
     ReDim tbzts(UBound(tbz))
     For m = LBound(tbz) To UBound(tbz)
        temp = tbz(m)
        n = InStr(temp, ":")
        tbzts(m) = Mid(temp, n + 1)
        tbz(m) = Left(temp, n - 1)
     Next
  End If
  Set wshshell = CreateObject("WScript.Shell")
  strpath = wshshell.CurrentDirectory
  Set wordapp = CreateObject("Word.Application")
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set jdb = wordapp.documents.Open(strpath & "\" & bkname & ".doc")
  Set ja = wordapp.documents.Add
  bh = 1
  i = 1
  Do
  If InStr(jdb.Tables(1).cell(i, 1).Range.Text, "周次") <> 0 Then i = i + 2
  For k = 1 To UBound(sz)
   tbzflag = False
   For x = LBound(tbz) To UBound(tbz)
    If InStr(jdb.Tables(1).cell(i, 1).Range.Text, tbz(x)) <> 0 Then
      tbzflag = True
      tbzxb = x
    End If
   Next
   If tbzflag Then
     dz = Split(tbzts(tbzxb), ",")
     skzjxb = 0
     skzjxb = InStr(jdb.Tables(1).cell(i, 3).Range.Text, "*放假")
     skzjxb = InStr(jdb.Tables(1).cell(i, 3).Range.Text, "*补课")
     If skzjxb <> 0 Then
         skzj = Left(jdb.Tables(1).cell(i, 3).Range.Text, skzjxb - 1)
     Else
         skzj = Left(jdb.Tables(1).cell(i, 3).Range.Text, Len(jdb.Tables(1).cell(i, 3).Range.Text) - 2)
     End If
   Else
     dz = Split(sz(k), ",")
     skzj = Left(jdb.Tables(1).cell(i, 3).Range.Text, Len(jdb.Tables(1).cell(i, 3).Range.Text) - 2)
   End If
   If (InStr(sz(k), "*") <> 0 And tbzflag = False) Or (InStr(tbzts(tbzxb), "*") <> 0 And tbzflag = True) Then
      bzysy = True
   Else
      bzysy = False
   End If
   rqstart = rq
   For j = 0 To UBound(dz)
   If InStr(dz(j), "*") <> 0 Then
        dz(j) = Left(dz(j), Len(dz(j)) - 1)
        kx = "实验"
    Else
        kx = "理论"
    End If
    rq = DateAdd("d", CDate(rqstart), dz(j))
    rq = Year(rq) & "年" & Month(rq) & "月" & Day(rq) & "日"
    Call genoneja(i, rq, kx)
   Next
   rq = DateAdd("d", CDate(rqstart), 7)
   Erase dz
   i = i + 1
   If Len(jdb.Tables(1).cell(i, 1).Range.Text) <= 2 Then Exit For
  Next
  Loop Until Len(jdb.Tables(1).cell(i, 1).Range.Text) <= 2
  ja.SaveAs strpath & "\教案.doc"
  ja.Close
  jdb.Close
  wordapp.Quit
  Set fso = Nothing
  Set ja = Nothing
  Set jdb = Nothing
  Set wordapp = Nothing
  Set wshshell = Nothing
  MsgBox "完工啦"
 
Function trimstr(str)
do while  (right(str,1)=chr(13)) or (right(str,1)=chr(10))
str=left(str,len(str)-1)
loop
do while  (left(str,1)=chr(13)) or (left(str,1)=chr(10))
str=right(str,len(str)-1)
loop
trimstr=str
end Function
  
Sub genoneja(i, rq, kx)
  fso.copyfile strpath & "\教案模板.doc", strpath & "\temp.doc"
  Set tempf = wordapp.documents.Open(strpath & "\temp.doc")
  tempf.Activate
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  With wordapp.ActiveWindow.Selection
      .Find.Execute "授课日期"
       If .Find.Found = True Then
           .MoveEndUntil "日"
           .MoveRight 2, 1, 1
           .Text = "授课日期: " & CStr(rq)
       End If
  End With
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《教案编号》"
  wordapp.ActiveWindow.Selection.Text = bh
  bh = bh + 1
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《课型》"
  kx=trimstr(kx)
  wordapp.ActiveWindow.Selection.Text = kx
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  jxfs = Left(jdb.Tables(1).cell(i, 6).Range.Text, Len(jdb.Tables(1).cell(i, 6).Range.Text) - 2)
  wordapp.ActiveWindow.Selection.Find.Execute "《教学方式》"
  If bzysy = True Then
     xb = InStr(jxfs, "实验")
     If kx = "理论" Then
       wordapp.ActiveWindow.Selection.Text = trimstr(Left(jxfs, xb - 1))
     Else
       wordapp.ActiveWindow.Selection.Text = trimstr(Mid(jxfs, CInt(xb), Len(jxfs) - 2))
     End If
    Else
     wordapp.ActiveWindow.Selection.Text = trimstr(jxfs)
  End If
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《授课章节》"
  If bzysy = True Then
     xb = InStr(skzj, "实验")
     If kx = "理论" Then
       wordapp.ActiveWindow.Selection.Text = trimstr(Left(skzj, xb - 1))
     Else
       wordapp.ActiveWindow.Selection.Text = trimstr(Mid(skzj, xb))
     End If
    Else
    wordapp.ActiveWindow.Selection.Text = trimstr(skzj)
  End If
  If kx = "实验" Then
       jxmd = "": jxznd = "": zybz = ""
     Else
       jxmd = Left(jdb.Tables(1).cell(i, 4).Range.Text, Len(jdb.Tables(1).cell(i, 4).Range.Text) - 2)
       jxznd = Left(jdb.Tables(1).cell(i, 5).Range.Text, Len(jdb.Tables(1).cell(i, 5).Range.Text) - 2)
       zybz = Left(jdb.Tables(1).cell(i, 7).Range.Text, Len(jdb.Tables(1).cell(i, 7).Range.Text) - 2)
  End If
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《教学目的》"
  wordapp.ActiveWindow.Selection.Text = trimstr(jxmd)
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《教学重点与难点》"
  wordapp.ActiveWindow.Selection.Text = trimstr(jxznd)
  wordapp.ActiveWindow.Selection.HomeKey 6, 0
  wordapp.ActiveWindow.Selection.Find.Execute "《作业布置》"
  wordapp.ActiveWindow.Selection.Text = trimstr(zybz)
  tempf.Save
  tempf.Close
  ja.Activate
  wordapp.ActiveWindow.Selection.EndKey 6, 0
  wordapp.ActiveWindow.Selection.InsertFile strpath & "\temp.doc"
  wordapp.ActiveWindow.Selection.InsertBreak 7
  fso.deletefile (strpath & "\temp.doc")
End Sub
 
 
  评论这张
 
阅读(108)| 评论(1)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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