|
守柔版主,你好我大概要做1300多页，现在是15页的数据，其它的名单如何按你方法去更快做好，谢谢！ 在以下代码中如何修改？ 以下代码供参考:(于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
| 
楼主: lhz168
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-3-25 13:49
楼主