如何用VBA实现将Excel数据依次写入Word模板

ugyun

非常感谢老师的代码，这种方法还是第一次见啊，我不懂VBS脚本，试了下，没成功，很谢谢老师

ugyun

谢谢老师的答复，试了下，可以生成word，不过每一行数据都生成了一个word，我数据非常多，要是能实现无论有多少行数据只生成一个word就好了，这样也方便打印

qdchyq

已经修改！！！！！！

[ 本帖最后由 qdchyq 于 2011-6-8 10:58 编辑 ]

xtanuihazfh

这样的话你可以直接用邮件合并了

jiminyanyan

先收下。。。。。

woxinaihai

请问如果没有word源文件，直接导出一个新word该如何操作呢？

沟壑中的鱼庚

用word里面的邮件合并功能 就可以解决了

沟壑中的鱼庚

沟壑中的鱼庚 发表于 2015-10-17 15:24
用word里面的邮件合并功能 就可以解决了

Sub 宏3()
'
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "C:\Users\xz\Desktop\新建文件夹\统计表.xls", ConfirmConversions:=False, ReadOnly _
        :=False, LinkToSource:=True, AddToRecentFiles:=False, PasswordDocument:= _
        "", PasswordTemplate:="", WritePasswordDocument:="", _
        WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
        Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\xz\Desktop\新建文件夹\统计表.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=" _
        , SQLStatement:="SELECT * FROM `统计表$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
    Selection.MoveDown Unit:=wdLine, Count:=5
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=3
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=4
    Selection.MoveUp Unit:=wdLine, Count:=7
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="编号"
    Selection.MoveDown Unit:=wdLine, Count:=5
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.MoveDown Unit:=wdLine, Count:=5
    Selection.MoveLeft Unit:=wdCharacter, Count:=3
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="姓___名"
    Selection.MoveDown Unit:=wdLine, Count:=3
    Selection.MoveLeft Unit:=wdCharacter, Count:=4
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="日期"
    Selection.MoveRight Unit:=wdCharacter, Count:=7
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="金额"
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=20
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="大写"
    Selection.MoveRight Unit:=wdCharacter, Count:=9
    ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:="发放方式"
    Selection.HomeKey Unit:=wdLine
    Selection.MoveRight Unit:=wdCharacter, Count:=4
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=12
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=7
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=20
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveUp Unit:=wdLine, Count:=8
    Selection.MoveRight Unit:=wdCharacter, Count:=4
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.Delete Unit:=wdCharacter, Count:=1
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With
End Sub

xrmay

留个记号，以后学习。

LMY123

EXCEL TO WORD