zoukankan      html  css  js  c++  java
  • 以黄门镇黄湾村某一扶贫文档为例——将Excel数据填入到已存在的Word模板

     傻瓜可以写出机器读得懂代码,但写出让人能读懂的代码的是优秀程序员

    作用:通过Excel文件中的一列数据作为文件名创建Word文档,并将Excel中的一行数据填一表,实现自动化
    Excel的VBA宏代码
    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

    将VBA代码改为Visual Basic 2013控制台程序

    Imports System.IO
    Imports Microsoft.Office.Interop.Excel
    Imports Microsoft.Office.Interop.Word
    Module Module1
    
        Sub Main()
            Console.WriteLine("正在执行操作,请等待操作完成…………")
            Dim excelApp As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application
            excelApp.ScreenUpdating = False      'ScreenUpdating 是控制你的excel是否按步骤刷新显示宏执行过程,所有单元格同时执行 
            Dim localExcelPath, localDocPath As String
            localExcelPath = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location)           '执行程序所在的目录,也就是项目中bindebug目录
            localDocPath = localExcelPath & "附件1贫困户信息采集表.docx"     
    
            Dim objExcelApp As Microsoft.Office.Interop.Excel._Application = New Microsoft.Office.Interop.Excel.Application() '实例化Excel应用程序
            objExcelApp.Visible = False
            Dim workbook As Microsoft.Office.Interop.Excel._Workbook = objExcelApp.Workbooks.Open(localExcelPath & "黄湾户表数据1.xlsx")
            Dim worksheet As Microsoft.Office.Interop.Excel._Worksheet = DirectCast(workbook.Sheets(1), Microsoft.Office.Interop.Excel.Worksheet) 'DirectCast类似于Ctype,不过要求必须前后的类型一致
            Dim aRowCount As Integer
            Dim wordPageAllRows As Integer = 18 '
            aRowCount = worksheet.Range("A1").CurrentRegion.Cells.Rows.Count '将本Excel的A列的A1单元格算起的所有行的数量赋值给aRow变量
            For i = 2 To aRowCount    '遍历数据行
                'FileCopy(localDocPath, localExcelPath & "生成的文件" & i - 1 & worksheet.Cells(i, 1).Text & ".docx")
                FileCopy(localDocPath, localExcelPath & "" & i - 1 & worksheet.Cells(i, 1).Text & ".docx")     '复制空模板并以第一列单元格的字符作为新产生的文档名称
                Dim wordApp As Microsoft.Office.Interop.Word.Application = New Microsoft.Office.Interop.Word.Application
                Dim wordDoc As Microsoft.Office.Interop.Word.Document
                'wordDoc = wordApp.Documents.Open(localExcelPath & "生成的文件" & i - 1 & worksheet.Cells(i, 1).Text & ".docx")
                wordDoc = wordApp.Documents.Open(localExcelPath & "" & i - 1 & worksheet.Cells(i, 1).Text & ".docx")
    '**************第一个表************************************************************************************ 'wordDoc.Tables.Item(1).Cell(2 + wordPageAllRows, 2).Range.Text = worksheet.Cells(i, 2).Text '***** wordDoc.Tables.Item(1).Cell(2 + wordPageAllRows, 2).Range.Text = worksheet.Range("B" & i).Value '***** wordDoc.Tables.Item(1).Cell(2 + wordPageAllRows, 4).Range.Text = worksheet.Range("D" & i).Value '***** wordDoc.Tables.Item(1).Cell(2 + wordPageAllRows, 6).Range.Text = worksheet.Range("F" & i).Value '***** wordDoc.Tables.Item(1).Cell(3 + wordPageAllRows, 2).Range.Text = worksheet.Range("C" & i).Value '***** 'wordDoc(1).Cell(3, 4).Range.Text = worksheet.Cells(i, 5).Text '***** wordDoc.Tables.Item(1).Cell(3 + wordPageAllRows, 6).Range.Text = worksheet.Range("G" & i).Value '***** wordDoc.Tables.Item(1).Cell(4 + wordPageAllRows, 2).Range.Text = worksheet.Range("AK" & i).Value '***** wordDoc.Tables.Item(1).Cell(4 + wordPageAllRows, 4).Range.Text = worksheet.Range("E" & i).Value '***** wordDoc.Tables.Item(1).Cell(4 + wordPageAllRows, 6).Range.Text = worksheet.Range("H" & i).Value '***** 'wordDoc(1).Cell(5, 2).Range.Text = worksheet.Cells(i, 2).Text '***** 'wordDoc(1).Cell(5, 4).Range.Text = worksheet.Cells(i, 4).Text '***** wordDoc.Tables.Item(1).Cell(5 + wordPageAllRows, 6).Range.Text = worksheet.Range("I" & i).Value '***** '********************************************************************************************************* '*********************第二个表***************************************************************************** wordDoc.Tables.Item(1).Cell(7 + wordPageAllRows, 2).Range.Text = worksheet.Range("J" & i).Value ''''* 'wordDoc.Tables.Item(1).Cell(8, 2).Range.Text = worksheet.Cells(i, 4).Text ''''* wordDoc.Tables.Item(1).Cell(9 + wordPageAllRows, 2).Range.Text = worksheet.Range("K" & i).Value ''''* wordDoc.Tables.Item(1).Cell(10 + wordPageAllRows, 2).Range.Text = worksheet.Range("L" & i).Value ''''* wordDoc.Tables.Item(1).Cell(11 + wordPageAllRows, 2).Range.Text = worksheet.Range("M" & i).Value ''''* wordDoc.Tables.Item(1).Cell(12 + wordPageAllRows, 2).Range.Text = worksheet.Range("N" & i).Value ''''* 'wordDoc.Tables.Item(1).Cell(13, 2).Range.Text = worksheet.Cells(i, ).Text ''''* wordDoc.Tables.Item(1).Cell(7 + wordPageAllRows, 4).Range.Text = worksheet.Range("O" & i).Value ''''* wordDoc.Tables.Item(1).Cell(8 + wordPageAllRows, 4).Range.Text = worksheet.Range("P" & i).Value ''''* wordDoc.Tables.Item(1).Cell(9 + wordPageAllRows, 4).Range.Text = worksheet.Range("Q" & i).Value ''''* wordDoc.Tables.Item(1).Cell(9 + wordPageAllRows, 4).Range.Font.Size = 8 ''''*设置字号 wordDoc.Tables.Item(1).Cell(10 + wordPageAllRows, 4).Range.Text = worksheet.Range("R" & i).Value ''''* wordDoc.Tables.Item(1).Cell(11 + wordPageAllRows, 4).Range.Text = worksheet.Range("U" & i).Value ''''* wordDoc.Tables.Item(1).Cell(12 + wordPageAllRows, 4).Range.Text = worksheet.Range("V" & i).Value ''''* wordDoc.Tables.Item(1).Cell(13 + wordPageAllRows, 4).Range.Text = worksheet.Range("W" & i).Value ''''* wordDoc.Tables.Item(1).Cell(7 + wordPageAllRows, 6).Range.Text = worksheet.Range("X" & i).Value ''''* wordDoc.Tables.Item(1).Cell(8 + wordPageAllRows, 6).Range.Text = worksheet.Range("Y" & i).Value ''''* wordDoc.Tables.Item(1).Cell(9 + wordPageAllRows, 6).Range.Text = worksheet.Range("Z" & i).Value ''''* '********************************************************************************************************* '*********************第三个表******************************************************************************* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 2).Range.Text = worksheet.Range("AA" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 3).Range.Text = worksheet.Range("AB" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 4).Range.Text = worksheet.Range("AC" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 5).Range.Text = worksheet.Range("AD" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 6).Range.Text = worksheet.Range("AE" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 7).Range.Text = worksheet.Range("AF" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 7).Range.Font.Size = 7 ''''*设置字号 wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 8).Range.Text = worksheet.Range("AG" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 8).Range.Font.Size = 6.5 ''''*设置字号 wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 9).Range.Text = worksheet.Range("AH" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 9).Range.Font.Size = 8 ''''*设置字号 wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 10).Range.Text = worksheet.Range("AI" & i).Value ''''* wordDoc.Tables.Item(1).Cell(16 + wordPageAllRows, 11).Range.Text = worksheet.Range("AJ" & i).Value ''''* '*********************************************************************************************************** wordDoc.Save() wordApp.Quit() wordDoc = Nothing wordApp.ScreenUpdating = True '所有单元格不同时执行,在本程序中,当所有的文件没有全部生产之前,是不能打开已经生产的文件的 'excelApp.ScreenUpdating = True Next i workbook.Save() workbook.Close() excelApp.Quit() 'excelApp = Nothing 'excelApp.ScreenUpdating = True '所有单元格不同时执行,在本程序中,当所有的文件没有全部生产之前,是不能打开已经生产的文件的 Console.WriteLine("数据操作已完成,共完成" & aRowCount - 1 & "项数据!!") Console.Read() End Sub End Module '********************************************************************************************************************* '此实例的作用就是将用户的Word文档“贫困户信息采集表.docx”复制到“生成的文件”文件夹下,复制后的文件名是以Excel中 '第一列的数据作为文件名,前面再加上标号1、2、3、4…… 比如说,1张三.docx,2李四.docx,3王五.docx等等。并将Excel中的 '数据填充到所复制后的Word中。 '**************************************************************** ****************************************************

     旧代码片段:

                ''**************第一个表*************************************************************
                'wordDoc.Tables.Item(1).Cell(2, 2).Range.Text = worksheet.Cells(i, 2).Text     '*****
                'wordDoc.Tables.Item(1).Cell(2, 4).Range.Text = worksheet.Cells(i, 4).Text     '*****
                'wordDoc.Tables.Item(1).Cell(2, 6).Range.Text = worksheet.Cells(i, 6).Text     '*****
                'wordDoc.Tables.Item(1).Cell(3, 2).Range.Text = worksheet.Cells(i, 3).Text     '*****
                ''wordDoc(1).Cell(3, 4).Range.Text = worksheet.Cells(i, 5).Text                '*****
                'wordDoc.Tables.Item(1).Cell(3, 6).Range.Text = worksheet.Cells(i, 7).Text     '*****
                'wordDoc.Tables.Item(1).Cell(4, 2).Range.Text = worksheet.Cells(i, 37).Text    '*****
                'wordDoc.Tables.Item(1).Cell(4, 4).Range.Text = worksheet.Cells(i, 5).Text     '*****
                'wordDoc.Tables.Item(1).Cell(4, 6).Range.Text = worksheet.Cells(i, 8).Text     '*****
                ''wordDoc(1).Cell(5, 2).Range.Text = worksheet.Cells(i, 2).Text                '*****
                ''wordDoc(1).Cell(5, 4).Range.Text = worksheet.Cells(i, 4).Text                '*****
                'wordDoc.Tables.Item(1).Cell(5, 6).Range.Text = worksheet.Cells(i, 9).Text     '*****
                'wordDoc.Tables.Item(1).Cell(2, 2).Range.Text = worksheet.Cells(i, 2).Text     '*****
                'wordDoc.Tables.Item(1).Cell(2, 4).Range.Text = worksheet.Cells(i, 4).Text     '*****
                'wordDoc.Tables.Item(1).Cell(2, 6).Range.Text = worksheet.Cells(i, 6).Text     '*****
                ''***********************************************************************************
    
    
                ''*********************第二个表*******************************************************
                'wordDoc.Tables.Item(1).Cell(7, 2).Range.Text = worksheet.Cells(i, 10).Text      ''''*
                ''wordDoc.Tables.Item(1).Cell(8, 2).Range.Text = worksheet.Cells(i, 4).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(9, 2).Range.Text = worksheet.Cells(i, 11).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(10, 2).Range.Text = worksheet.Cells(i, 12).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(11, 2).Range.Text = worksheet.Cells(i, 13).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(12, 2).Range.Text = worksheet.Cells(i, 14).Text     ''''*
                ''wordDoc.Tables.Item(1).Cell(13, 2).Range.Text = worksheet.Cells(i, ).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(7, 4).Range.Text = worksheet.Cells(i, 15).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(8, 4).Range.Text = worksheet.Cells(i, 16).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(9, 4).Range.Text = worksheet.Cells(i, 17).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(9, 4).Range.Font.Size = 8                           ''''*设置字号
                'wordDoc.Tables.Item(1).Cell(10, 4).Range.Text = worksheet.Cells(i, 18).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(11, 4).Range.Text = worksheet.Cells(i, 21).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(12, 4).Range.Text = worksheet.Cells(i, 22).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(13, 4).Range.Text = worksheet.Cells(i, 23).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(7, 6).Range.Text = worksheet.Cells(i, 24).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(8, 6).Range.Text = worksheet.Cells(i, 25).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(9, 6).Range.Text = worksheet.Cells(i, 26).Text      ''''*
                ''************************************************************************************
    
    
    
                ''*********************第三个表********************************************************
                'wordDoc.Tables.Item(1).Cell(16, 2).Range.Text = worksheet.Cells(i, 27).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 3).Range.Text = worksheet.Cells(i, 28).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 4).Range.Text = worksheet.Cells(i, 29).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 5).Range.Text = worksheet.Cells(i, 30).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 6).Range.Text = worksheet.Cells(i, 31).Text      ''''* 
                'wordDoc.Tables.Item(1).Cell(16, 7).Range.Text = worksheet.Cells(i, 32).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 7).Range.Font.Size = 7                           ''''*设置字号
                'wordDoc.Tables.Item(1).Cell(16, 8).Range.Text = worksheet.Cells(i, 33).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 8).Range.Font.Size = 6.5                         ''''*设置字号
                'wordDoc.Tables.Item(1).Cell(16, 9).Range.Text = worksheet.Cells(i, 34).Text      ''''*
                'wordDoc.Tables.Item(1).Cell(16, 9).Range.Font.Size = 8                            ''''*设置字号
                'wordDoc.Tables.Item(1).Cell(16, 10).Range.Text = worksheet.Cells(i, 35).Text     ''''*
                'wordDoc.Tables.Item(1).Cell(16, 11).Range.Text = worksheet.Cells(i, 36).Text     ''''*
                ''*************************************************************************************
    
              
  • 相关阅读:
    二叉树相关题目
    二叉树的遍历
    mysql获取某个表中除了某个字段名外的所有字段名
    设计模式之原型模式
    设计模式之工厂方法模式
    设计模式之代理模式
    设计模式之装饰模式
    设计模式之策略模式
    设计模式之简单工厂模式
    Redis的使用及参考代码
  • 原文地址:https://www.cnblogs.com/xiehaofeng/p/6116035.html
Copyright © 2011-2022 走看看