|
Excel信息生成Word文檔，是很多朋友經(jīng)常遇到的場(chǎng)景，一條兩條信息還好，但是如果有幾百上千條信息，手動(dòng)的去把excel內(nèi)部的數(shù)據(jù)挪到Word里面，就很麻煩而且不現(xiàn)實(shí)了。這個(gè)時(shí)候，用VBA來(lái)支持，就能極大的提高效率。 今天就來(lái)講一個(gè)典型的案例，本案例涉及知識(shí)點(diǎn)較多，例如：修改Word的頁(yè)眉頁(yè)腳內(nèi)容（包含頁(yè)碼）、修改Word中的表格、新建文件夾等等，非常的經(jīng)典。 可以說(shuō)，把這個(gè)案例搞清楚了，Excel與Word數(shù)據(jù)交互的需求基本都不在話下了。 我有這樣兩個(gè)文件：
Word模板 
我的具體需求：
取數(shù)據(jù)源表中的供應(yīng)商，填至供應(yīng)商名稱欄位（尊敬的：后面）； 思路：找到關(guān)鍵字之后，光標(biāo)挪動(dòng)寫入內(nèi)容
取數(shù)據(jù)源表中的供應(yīng)商的往來(lái)業(yè)務(wù)數(shù)據(jù)，插入至格式中的“1. 本公司與貴公司的往來(lái)賬項(xiàng)”下的表格；表格后的內(nèi)容自動(dòng)下移。 思路：根據(jù)每個(gè)供應(yīng)商的數(shù)據(jù)條數(shù)來(lái)新增不同行數(shù)。 保存文件時(shí)以供應(yīng)商名稱保存為文件名稱，每個(gè)供應(yīng)商獨(dú)立一個(gè)文件 思路：保存文件的時(shí)候，文件名注意一下 幫我加上頁(yè)腳的頁(yè)數(shù)“第幾頁(yè)，共幾頁(yè) 思路：修改頁(yè)眉頁(yè)腳內(nèi)容
具體代碼如下： Public info() '定義動(dòng)態(tài)數(shù)組，存儲(chǔ)每個(gè)供應(yīng)商的具體信息 Public 供應(yīng)商 Public doc Public wd Public PathG Public i Public docname Public 貸方合計(jì) Public 借方合計(jì)Sub 拆分excel至word() Call 創(chuàng)建文件夾 貸方合計(jì) = 0 借方合計(jì) = 0 Set doc = CreateObject("word.application") '創(chuàng)建Word對(duì)象 arr = Sheet2.UsedRange '把數(shù)據(jù)2中的數(shù)據(jù)賦值給數(shù)組arr，這里也可以寫成arr=worksheets("數(shù)據(jù)2") Set d = CreateObject("scripting.dictionary") '創(chuàng)建字典，為了去重獲取供應(yīng)商名稱 For i = 2 To UBound(arr) d(arr(i, 13)) = "" '去重寫入字典 Next 供應(yīng)商 = d.keys '這里供應(yīng)商就是所有供應(yīng)商的數(shù)組 '顯示進(jìn)度條 On Error GoTo 1 For i = 0 To UBound(供應(yīng)商) '------------------------------- Set wd = doc.Documents.Open(ThisWorkbook.Path & "\模板.docx") '打開模板 'doc.Visible = True For j = 1 To UBound(arr) If arr(j, 13) = 供應(yīng)商(i) Then docname = arr(j, 12) '供應(yīng)商編碼，作為文檔保存時(shí)候的命名 k = k + 1 ReDim Preserve info(1 To 6, 1 To k) info(1, k) = arr(j, 1) '制單日期 info(2, k) = arr(j, 9) '科目名稱 info(3, k) = arr(j, 3) '摘要 info(4, k) = arr(j, 4) '借方 info(5, k) = arr(j, 5) '貸方 info(6, k) = arr(j, 6) '會(huì)計(jì)期間 借方合計(jì) = Val(info(4, k)) + 借方合計(jì) 貸方合計(jì) = Val(info(5, k)) + 貸方合計(jì) End If Next j Call 寫入word 貸方合計(jì) = 0 借方合計(jì) = 0 k = 0 Next i1: doc.Quit '關(guān)閉Word程序窗口 MsgBox "完成！"End SubSub 寫入word() 'endkey方法 '//寫入供應(yīng)商 doc.Visible = True With doc.Selection.Find .ClearFormatting .MatchWholeWord = True .MatchCase = False t = .Execute(FindText:="尊敬的") '查找尊敬的三個(gè)字的位置 End With doc.Selection.endkey unit:=5 doc.Selection.TypeText 供應(yīng)商(i) & "：" '//寫入往來(lái)賬項(xiàng) '--調(diào)整表格-- Set tbl = wd.Tables(1) tbl.Select '選中需要填入數(shù)據(jù)的表格'不選中，后面無(wú)法插入行，InsertRowsBelow是selection的方法 ' If UBound(info, 2) > 1 Then doc.Selection.InsertRowsBelow UBound(info, 2) - 1 '根據(jù)總數(shù)據(jù)條數(shù)插入行,如果只有一條數(shù)據(jù)，不插入行 doc.Selection.InsertRowsBelow UBound(info, 2) '根據(jù)總數(shù)據(jù)條數(shù)插入行,如果只有一條數(shù)據(jù)，不插入行 tbl.Style = "網(wǎng)格型" '--寫入數(shù)據(jù)-- For r = 1 To UBound(info, 2) tbl.Cell(r + 1, 1).Range = info(1, r) tbl.Cell(r + 1, 2).Range = info(2, r) tbl.Cell(r + 1, 3).Range = info(3, r) tbl.Cell(r + 1, 4).Range = info(4, r) tbl.Cell(r + 1, 5).Range = info(5, r) tbl.Cell(r + 1, 6).Range = info(6, r) Next tbl.Cell(r + 1, 4).Range = 借方合計(jì) tbl.Cell(r + 1, 5).Range = 貸方合計(jì) tbl.Cell(r + 1, 6).Range = 借方合計(jì) - 貸方合計(jì) Call 添加頁(yè)眉頁(yè)腳 doc.ActiveDocument.SaveAs Filename:=PathG & "\" & docname & ".docx" '----保存到C盤 doc.ActiveDocument.Close 0End SubSub 創(chuàng)建文件夾() 'FSO方式 PathG = ThisWorkbook.Path & "\往來(lái)對(duì)賬函" Set fso = CreateObject("Scripting.FileSystemObject") If fso.FolderExists(PathG) = True Then fso.getfolder(PathG).Delete '//刪除文件夾 MkDir PathG Else MkDir PathG '//創(chuàng)建文件夾 End IfEnd SubSub 添加頁(yè)眉頁(yè)腳() '//添加頁(yè)眉 With wd.Sections(1).Headers(1) Set Rng = .Range Rng.Text = 供應(yīng)商(i) .Range.Fields.Update .Range.ParagraphFormat.Alignment = 2 End With '刪除頁(yè)眉橫線 With wd.Styles("頁(yè)眉").ParagraphFormat .Borders(-3).LineStyle = 0 End With '//添加頁(yè)腳 With wd.Sections(1).Footers(1) Set Rng = .Range Rng.Text = "第 " Rng.Collapse 0 wd.Fields.Add Rng, 33, "Page" Set Rng = .Range Rng.Collapse 0 Rng.Text = " 頁(yè) 共 " Rng.Collapse 0 wd.Fields.Add Rng, 26, "Pages" Set Rng = .Range Rng.Collapse 0 Rng.Text = " 頁(yè) " & 供應(yīng)商(i) '頁(yè)腳要求，第幾頁(yè)共幾頁(yè)+供應(yīng)商名稱 .Range.Fields.Update .Range.ParagraphFormat.Alignment = 2 End WithEnd Sub
效果如下：
幾百條數(shù)據(jù)，一杯咖啡的時(shí)間就搞定了。 現(xiàn)在Python大炒辦公自動(dòng)化，其實(shí)上述效果這不就是辦公自動(dòng)化嗎？VBA內(nèi)置于Office才是最優(yōu)選擇。
|
