|
解决方案二：
EXCEL&WORD的Automation(自动化)解决方案:
以下代码供参考:
----------------------------------------------------------模块1----------------------------------------------------------
Sub WriteToWord()
Dim MyRange As Range, i As Range, LastAddress As String
Dim WdApp As Word.Application, Doc As Word.Document, N As Integer
On Error GoTo ErrHandle '启动错误处理程序
LastAddress = Sheets(1).[B65536].End(xlUp).Address 'B列最后一个数据
Set MyRange = Sheets(1).Range("B2:" & LastAddress) '定义循区域范围
Set WdApp = CreateObject("Word.Application") '创建WORD对象
N = 2 '从第二行开始
With WdApp
.ScreenUpdating = False '关闭WORD屏幕更新
Set Doc = .Documents.Open(ThisWorkbook.Path & "\pswxm.DOT") '打开该模板
'在与本工作薄同一文件夹下
For Each i In MyRange '在指定范围内循环
If i <> i.Offset(-1, 0) Then '如果该数据与下一数据不同
N = 2 '初始化N值
'移到文档最后
.Windows(Doc).Selection.EndKey Unit:=wdStory
'当I的行号非2时插入分页符
If i.Row > 2 Then .Windows(Doc).Selection.InsertBreak Type:=wdPageBreak
'光标处插入已设置的自动图文集
Doc.AttachedTemplate.AutoTextEntries("成绩表").Insert where:=.Windows(Doc).Selection.Range, _
RichText:=True
Else '否则则选定当前表格的最后一行并向下插入一行
Doc.Tables(Doc.Tables.Count).Rows(N).Select
WdApp.Windows(Doc).Selection.InsertRowsBelow 1
N = N + 1 '加1
End If
With Doc.Tables(Doc.Tables.Count) '对当前表格赋值
.Cell(N, 1).Range = i.Offset(, -1) '学期
.Cell(N, 2).Range = i '姓名
.Cell(N, 3).Range = i.Offset(, 1) '英语
.Cell(N, 4).Range = i.Offset(, 2) '高等数学
.Cell(N, 5).Range = i.Offset(, 3) 'C语言
End With
Next
.Visible = True 'WORD程序可见,假设此句放在上面,可在调试过程中看到WROD运行情况
.ScreenUpdating = True 'WORD屏幕更新恢复
End With
Application.ScreenUpdating = True
MsgBox "运行结束，请切换到WORD程序中进行编辑与打印设置！", vbOKOnly + vbInformation
Exit Sub
ErrHandle:
MsgBox "Excel & Word遇到不可遇见错误!请进行调试模式,进行调试!", vbOKOnly + vbCritical
End Sub
注意事项:
请在EXCEL中运行此过程.
如果需要设置表格和文字的格式,请右击该WORD模块,插入/自动图文集:(PSWXM.DOT),出现自动更正对话框/自动图文集选项卡中的查找范围内点取PSWXM(模板)如图,只有一个自动图文集,选中"成绩表"后插入,然后回到文档中进行设置,再选中该表格,插入/自动图文集,输入"成绩表"来重新定义该自动图文集,最后删除文档中的表格,保存后退出.
程序运行结束后,该WORD模板文件请另存为WORD文档,不可覆盖和不要保存该模板.
VXnItkVJ.zip
(17.55 KB, 下载次数: 196)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-1-14 09:34
楼主
