|
这是利用AUTOMATION（程序自动化）的一个代码，就是把EXCEL中的内容写到WORD中去。看了楼主的EXCEL，估计是新手，注意以下几个问题：
一：你的EXCEL、WORD宏安全请设为低；
二：建议在原EXCEL工作薄的内容中粘贴（即覆盖原内容（SHEETS（1）），如果需要在其它工作薄中运行代码，必须引用MICROSOFT WORD 10.0 OBJECT LIBRARY(VBE/引用)
三:如果不会,直接发上来,我给你完成
四:对需要修改的格式,可在"名为供货人".DOT中键入2004后按下F3,修改其中的自动图文集,再选中表格和表格下的段落标记,覆盖原有的自动图文集.
五:请解压在同一文件夹下:(供货人.DOT,数据.XLS)
六:成品表为已完成的表格.
七:注意,如果对WORD,EXCEL不熟悉,请在论坛上交流,我来修改,因为如果不慎修改自动图文集不当,则程序会出错.
八:最终结果可以直接打印,也可以另存为其它WORD.DOC(注意不是模板文档).
九:如果发现自动求和结果不对,不要紧,打印前它会自动更新(域)
以下代码供参考:(于EXCEL标准模块中)
----------------------------------------------------------模块1----------------------------------------------------------
Option Explicit
'运行此代码前,请检查VBE/工具 (T):/引用(R)/引用对话框中勾选:
'Microsoft Word 10.0 Object Library(10.0视版本号不同有所不同)
Sub PrintToWord()
Dim WdApp As Word.Application, WdDoc As Word.Document, I As Byte, MyRange As Range
Dim LastRange As String, C As Range, M As Byte, N As Byte
' On Error Resume Next'忽略错误
Application.ScreenUpdating = False '关闭屏幕更新
LastRange = Sheets(1).[B65536].End(xlUp).Address '取得B列最后一行行号
Set MyRange = Sheets(1).Range("B3:" & LastRange) '定义一个区域
Set WdApp = CreateObject("Word.Application") '创建一个WORD程序
With WdApp
' .Visible = True'显示,不写此句为隐藏,可加快运行速度
'打开一个与该EXCEL工作薄同一路径下的WORD供货人.DOT(模板)文件
Set WdDoc = .Documents.Open(ThisWorkbook.Path & "\供货人.DOT")
I = 1 '初始化变量
For Each C In MyRange '在指定区域中循环
'设定条件(如果I>15或者身份证号与上一个单元格不同或者I=1)
'则在WORD模板中插入带格式的名为2004的自动图文集
If I > 15 Or C.Offset(-1, 0) <> C Or I = 1 Then
I = 1: N = N + 1 'I初始化,N值累加
.ActiveDocument.AttachedTemplate.AutoTextEntries("2004").Insert _
where:=.Windows(WdDoc).Selection.Range, RichText:=True
End If
'对于WORD模板中的表格(N)
With .ActiveDocument.Tables(N)
If I = 1 Then
.Cell(2, 2).Range = C.Offset(, -1) '名字
.Cell(2, 4).Range = C '身份证号
.Cell(2, 6).Range = C.Offset(, 1) '地址
.Cell(22, 2).Range = "MYNAME" '请在此写入你的名字
.Cell(22, 4).Range = "MYLEADER" '请在此写入法人代表的名字
.Cell(22, 6).Range = "MYDATE" '请在此写入日期
End If
.Cell(I + 4, 1).Range = I '序号数
For M = 2 To 13 '依次次EXCELSHEETS(1)中的内容写入WORD表格中
.Cell(I + 4, M).Range = C.Offset(, M + 1)
Next M
End With
I = I + 1 '累加
Next
Application.ScreenUpdating = True '恢复屏幕更新
MsgBox "EXCEL-WORD工作已结束,您可以直接打印该WORD文档!"
.Visible = True
' WdDoc.PrintOut'此处可直接打印
' WdDoc.Close False'关闭并不保存该模板
' .Quit'退出WROD
End With
End Sub
m5bn9P0i.zip
(94.01 KB, 下载次数: 104)
[此贴子已经被作者于2005-3-25 7:22:04编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-3-24 14:29
楼主