需要把Excel中的数据一一填写到Word文档中,而Excel中的数据很长,并且Word文档中只需填写,其他的地方都不需要改动。手工操作实在让人无法忍受(不过,俺却手动完成了一遍,实在是......)。因为以前没有接触过VBS脚本类的东东,所以俺上网搜索了一下,汗,下面就是我的经历了,实在让人郁闷!
首先就是搜索Word正文和Word文档中的文本框里的文本(感觉好绕口)是不同。这里是我绕弯子绕的最多的了,因为以前从来没有接触过,根据就知道,花了我不下6个小时才了解,郁闷之一。
其次是,遍历文档中的文本框内容进行替换时,会丢失格式,目前还没有找到完美的方法,郁闷之二。
有了这两个郁闷,就已经够我喝一壶了,汗(确实喜欢用这个词)。
我的解决方法就是在需要替换的地方新置一个文本框,里面主上一个替换的字眼用以标注和查找替换用。
然后在遍历替换时,查看文本有没有变动。变动则更新文本内容!这就是我的笨方法,运行OK,事情也完成了,不过代码确实不堪!
为了给自己长个记性,把其他的一些用法用注释了,并没有删除掉。
[codes=vb]
' 通过Excel表格里的信息
' 使用Word模板批量生成Word文档
'
' Write By IAwen 2010-12-07
infoListXLS="E:\HR\info_Test.xls" '信息列表Excel文件名
wordTemplate="E:\HR\template.doc" 'Word模块文件名
wordOutputPath="E:\HR\" 'Word文件输出路径
'打开excel
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(infoListXLS)
objExcel.Visible=true
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
'从打开的Excel的第二行开始读取
intRow = 3
'Const wdReplaceAll = 2
'Const wdFindContinue = 1
Const msoTextBox = 17
'开始循环,直到第3列为空时退出循环
Do Until objExcel.Cells(intRow,3).Value = ""
'取得第3列、第4列内容:编号和公司名称
num=objExcel.Cells(intRow,3).Value
company=objExcel.Cells(intRow,4).Value
fileName = wordOutputPath & "HR互动邀请信" & num & ".doc"
FSO.CopyFile wordTemplate, fileName
'打开新做成的Word文档,并将姓名跟性别填入Word文档的表格中
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(fileName)
'遍历文档中的所有文本框
For Each sharp In objDoc.Shapes
If sharp.Type=msoTextBox Then
tmpString=sharp.TextFrame.TextRange.Text
newString=Replace(tmpString,"##company##", company)
If tmpString <> newString Then
sharp.TextFrame.TextRange.Text = newString
End If
tmpString=sharp.TextFrame.TextRange.Text
newString=Replace(tmpString,"##number##", num)
If tmpString <> newString Then
sharp.TextFrame.TextRange.Text = newString
End If
End If
Next
'搜索文档正文
'Set objSelection = objWord.Selection
'objSelection.Find.Text = "##company##" '查找的文本
'objSelection.Find.Replacement.Text = company
'objSelection.Find.Forward = True
'objSelection.Find.Wrap = wdFindContinue
'objSelection.Find.Format = False
'objSelection.Find.MatchCase = False
'objSelection.Find.MatchWholeWord = True
'objSelection.Find.MatchWildcards = False
'objSelection.Find.MatchSoundsLike = False
'objSelection.Find.MatchAllWordForms = False
'objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
'保存文件
objDoc.save()
Set objDoc=Nothing
objWord.Quit
intRow = intRow + 1
Loop
'退出Excel
objExcel.Quit
测试文档与脚本文件下载:
[file][attach]403[/attach][/file]