VBA嘘嘘嘘(1)——将Excel数据填入到已存在的Word模板表格(实例应用)

时间：2022-11-06 12:38:37

 

傻瓜可以写出机器读懂得代码，但写出让人能读懂的代码的是优秀程序员
Sub 填充()

    Application.ScreenUpdating = False    'ScreenUpdating 是控制你的excel是否按步骤刷新显示宏执行过程，所有单元格同时执行

    p = ThisWorkbook.Path & "/"           ’本文件所在的目录

    F = p & "附件1贫困户信息采集表.doc"     '本文件的路径

Dim myWS As Worksheet                 '定义一个Excel

Set myWS = ThisWorkbook.Sheets(1)     '将第一个工作表赋给对象myWS


Dim aRow As Integer                    '

    aRow = myWS.Range("A1").CurrentRegion.Cells.Rows.Count '将本Excel的A列的A1单元格算起的所有行的数量赋值给aRow变量


For i = 2 To aRow   '遍历数据行

FileCopy F, p & "生成的文件/" & i - 1 & myWS.Cells(i, 1).Text & ".doc"     '复制空模板并以第一列单元格的字符作为新产生的文档名称

Set wd = CreateObject("word.application")        '创建Word程序或调用Word程序

Set d = wd.documents.Open(p & "生成的文件/" & i - 1 & myWS.Cells(i, 1).Text & ".doc") '打开新文档



'**************第一个表**************************

        d.tables(1).Cell(2, 2) = myWS.Cells(i, 2).Text  '*        将Excel中第i行第2列的数据填充到Word中表格的第2行第2列

        d.tables(1).Cell(2, 4) = myWS.Cells(i, 4).Text  '*        

        d.tables(1).Cell(2, 6) = myWS.Cells(i, 6).Text  '*

        d.tables(1).Cell(3, 2) = myWS.Cells(i, 3).Text  '*

'd.tables(1).Cell(3, 4) = myWS.Cells(i, 5).Text '*

        d.tables(1).Cell(3, 6) = myWS.Cells(i, 7).Text  '*

'd.tables(1).Cell(4, 2) = myWS.Cells(i, 2).Text '*

        d.tables(1).Cell(4, 4) = myWS.Cells(i, 5).Text  '*

        d.tables(1).Cell(4, 6) = myWS.Cells(i, 8).Text  '*

'd.tables(1).Cell(5, 2) = myWS.Cells(i, 2).Text '*

'd.tables(1).Cell(5, 4) = myWS.Cells(i, 4).Text '*

        d.tables(1).Cell(5, 6) = myWS.Cells(i, 9).Text  '*

        d.tables(1).Cell(2, 2) = myWS.Cells(i, 2).Text  '*

        d.tables(1).Cell(2, 4) = myWS.Cells(i, 4).Text  '*

        d.tables(1).Cell(2, 6) = myWS.Cells(i, 6).Text  '*

'*************************************************





'*********************第二个表*************************

        d.tables(1).Cell(7, 2) = myWS.Cells(i, 10).Text      ''''*

'd.tables(1).Cell(8, 2) = myWS.Cells(i, 4).Text      ''''*

        d.tables(1).Cell(9, 2) = myWS.Cells(i, 11).Text      ''''*

        d.tables(1).Cell(10, 2) = myWS.Cells(i, 12).Text     ''''*

        d.tables(1).Cell(11, 2) = myWS.Cells(i, 13).Text     ''''*

        d.tables(1).Cell(12, 2) = myWS.Cells(i, 14).Text     ''''*

'd.tables(1).Cell(13, 2) = myWS.Cells(i, ).Text      ''''*

''''*

        d.tables(1).Cell(7, 4) = myWS.Cells(i, 15).Text      ''''*

        d.tables(1).Cell(8, 4) = myWS.Cells(i, 16).Text      ''''*

        d.tables(1).Cell(9, 4) = myWS.Cells(i, 17).Text      ''''*

        d.tables(1).Cell(9, 4).Range.Font.Size = 8           ''''*设置字号

        d.tables(1).Cell(10, 4) = myWS.Cells(i, 18).Text     ''''*

        d.tables(1).Cell(11, 4) = myWS.Cells(i, 21).Text     ''''*

        d.tables(1).Cell(12, 4) = myWS.Cells(i, 22).Text     ''''*

        d.tables(1).Cell(13, 4) = myWS.Cells(i, 23).Text     ''''*

''''*

        d.tables(1).Cell(7, 6) = myWS.Cells(i, 24).Text      ''''*

        d.tables(1).Cell(8, 6) = myWS.Cells(i, 25).Text      ''''*

        d.tables(1).Cell(9, 6) = myWS.Cells(i, 26).Text      ''''*

'*********************************************************







'*********************第三个表*************************

        d.tables(1).Cell(16, 2) = myWS.Cells(i, 27).Text      ''''*

        d.tables(1).Cell(16, 3) = myWS.Cells(i, 28).Text      ''''*

        d.tables(1).Cell(16, 4) = myWS.Cells(i, 29).Text      ''''*

        d.tables(1).Cell(16, 5) = myWS.Cells(i, 30).Text      ''''*

        d.tables(1).Cell(16, 6) = myWS.Cells(i, 31).Text      ''''*

        d.tables(1).Cell(16, 7) = myWS.Cells(i, 32).Text      ''''*

        d.tables(1).Cell(16, 7).Range.Font.Size = 7           ''''*设置字号

        d.tables(1).Cell(16, 8) = myWS.Cells(i, 33).Text      ''''*

        d.tables(1).Cell(16, 9) = myWS.Cells(i, 34).Text      ''''*

        d.tables(1).Cell(16, 9).Range.Font.Size = 8           ''''*设置字号

        d.tables(1).Cell(16, 10) = myWS.Cells(i, 35).Text     ''''*

        d.tables(1).Cell(16, 11) = myWS.Cells(i, 36).Text     ''''*

'*********************************************************

        d.Close

        wd.Quit

Set wd = Nothing

Next i



    Application.ScreenUpdating = True    '所有单元格不同时执行，在本程序中，当所有的文件没有全部生产之前，是不能打开已经生产的文件的

End Sub

 
标签：

相关文章