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

奕克

爱家人爱工作爱生活

 
 
 

日志

 
 

使用VBA+VBS批量根据excel文件填写word表格  

2012-05-11 14:53:25|  分类: office |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

  明天毕业生答辩,我们需要根据一张如下图的excel表格:

使用VBA+VBS批量根据excel文件填写word表格 - wucccsk - 天秤的存在与虚无博客

 

对每个学生,填写一批word文件中如下图的word表格,对格式等都有要求:

使用VBA+VBS批量根据excel文件填写word表格 - wucccsk - 天秤的存在与虚无博客

 

然后就写了个vbs脚本秒杀,程序实例在(http://dl.dbank.com/c0pdbzf4a6),双击batgenstu运行,用记事本打开看懂了程序,应该可以完成类似的批量填表任务。对格式的统一要求可以在模板文件夹里统一修改。

程序源代码如下:防止网盘被攻击,也可以直接拿这段文本建立vbs程序运行。

Set WshShell = WScript.CreateObject("WScript.Shell")
Set excelapp = CreateObject("Excel.Application")
set wordapp = CreateObject("Word.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Set md = excelapp.workbooks.Open(WshShell.CurrentDirectory & "\名单.xls")
zy=inputbox("输入学生专业:",,"计算机科学与技术")
for i=4 to md.worksheets(1).usedrange.rows.count
   create1stu()
next
md.close
set md=nothing
excelapp.quit
wordapp.quit
set fso=nothing
Set excelapp= Nothing
Set wordapp= Nothing
Set wshell = Nothing
MsgBox "OK"

sub create1stu()
If Not fso.FolderExists(WshShell.CurrentDirectory & "\" & md.worksheets(1).cells(i,4)) Then
       fso.CreateFolder (WshShell.CurrentDirectory & "\" & md.worksheets(1).cells(i,4))
End If
Set myfolder = fso.GetFolder(WshShell.CurrentDirectory & "\模板")
For Each myfile In myfolder.files
   temp=left(myfile.name,len(myfile.name)-4)
   if instr(myfile.name,"装订目录")=0 then
     create1file(temp)
    Else
    temppath=WshShell.CurrentDirectory & "\" & md.worksheets(1).cells(i,4) & "\"
    temppath=temppath & temp & "-" & md.worksheets(1).cells(i,3) &".doc"
    fso.copyfile WshShell.CurrentDirectory & "\模板\" & myfile.name,temppath
    end if
next
set myfolder=nothing
end sub

sub create1file(byval filename)
Set cl = wordapp.documents.Open(WshShell.CurrentDirectory & "\模板\" & filename &".doc")
cl.Content.Find.Execute "《专业》",,,,,, true,,,zy
cl.Content.Find.Execute "《班级》",,,,,, true,,,md.worksheets(1).cells(i,2)
cl.Content.Find.Execute "《姓名》",,,,,, true,,,md.worksheets(1).cells(i,3)
cl.Content.Find.Execute "《学号》",,,,,, true,,,md.worksheets(1).cells(i,4)
cl.Content.Find.Execute "《题目》",,,,,, true,,,md.worksheets(1).cells(i,5)
cl.Content.Find.Execute "《指导老师》",,,,,, true,,,md.worksheets(1).cells(i,6)
cl.saveas WshShell.CurrentDirectory &"\" & md.worksheets(1).cells(i,4) &"\"& filename & "-" & md.worksheets(1).cells(i,3) &".doc"
cl.close
set cl=nothing
end sub

  评论这张
 
阅读(1587)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

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

页脚

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