之前有兩篇文章過(guò)Excel和Word數(shù)據(jù)交互的基礎(chǔ)知識(shí)，這里說(shuō)個(gè)實(shí)際遇到的綜合案例，基本上將之前的知識(shí)點(diǎn)結(jié)合起來(lái)了。
一、實(shí)際案例引入
這次遇到的案例需求：將Excel數(shù)據(jù)批量寫入Word。需要寫入的內(nèi)容如下圖所示，紅色框里的內(nèi)容是需要寫入word的。
具體代碼如下：
Sub 提取數(shù)據(jù)()
Application.ScreenUpdating = False
Set doc = CreateObject(“word.application”)
doc.Visible = True
Set wd = doc.Documents.Add
pth = Application.GetOpenFilename(“文件(*.*),*.*”, , “請(qǐng)選擇文件”, , True)
For i = 1 To UBound(pth) ‘循環(huán)打開(kāi)選擇的工作簿
Set wb = Workbooks.Open(pth(i)) ‘把打開(kāi)的工作簿賦值給對(duì)象變量wb
strr = “訂單號(hào)碼” & wb.Worksheets(1).[b3] & vbTab & “客款號(hào) ” & wb.Worksheets(1).[b5] & vbTab & “廠款號(hào)” & wb.Worksheets(1).[b6] ‘將需要寫入的數(shù)據(jù)連接起來(lái)賦值給變量strr
doc.ActiveDocument.Content.InsertAfter Chr$(13) & strr ‘將訂單編號(hào)、客款號(hào)、廠款號(hào)寫入word
With wb.Worksheets(1)
col1 = .Columns(1).Find(“廠款號(hào)”, , xlValues, xlWhole, xlByColumns, xlNext, True, True).Row ‘定位廠款號(hào)跟合計(jì)字符，為了確定需要插入word文檔中表格的大小
col2 = .Columns(1).Find(“合計(jì)”, , xlValues, xlWhole, xlByColumns, xlNext, True, True).Row
Set myrange = doc.ActiveDocument.Content
myrange.Collapse Direction:=wdCollapseEnd ‘折疊已經(jīng)寫入的內(nèi)容
doc.Documents(1).Tables.Add myrange, col2 – col1, 11 ‘在word中插入新的表
doc.Documents(1).Tables(i).Style = “網(wǎng)格型” ‘表格類型是網(wǎng)格型
For r = col1 To col2 – 1
arr = .Range(“a” & r).EntireRow.Range(“a1:k1”) ‘循環(huán)將excel表中的數(shù)據(jù)寫入word表格中
For Each ar In arr
n = n + 1 ‘將所在行的單元格值循環(huán)寫入word表的單元格中
doc.Documents(1).Tables(i).Range.Cells(n).Range = ar
Next
Next
n = 0
End With
wb.Close False ‘數(shù)據(jù)寫入完畢，關(guān)閉打開(kāi)的工作簿’接著打開(kāi)后面一個(gè)工作簿
Next
doc.Documents(1).SaveAs ThisWorkbook.Path & “\數(shù)據(jù).docx” ‘將所有的工作簿循環(huán)打開(kāi)，寫入數(shù)據(jù)完畢，保存打開(kāi)的word文檔到代碼工作簿路徑下
doc.Quit ‘退出程序
Application.ScreenUpdating = True
End Sub
三、知識(shí)點(diǎn)
新建表格
代碼中涉及到新建表格并寫入數(shù)據(jù)的地方，這里給一個(gè)簡(jiǎn)單的例子作為參考。（這個(gè)代碼直接在Word VBA中運(yùn)行，如果需要在Excel中操作Word插入表格，需要新建Word程序?qū)ο螅@屬于前面的基礎(chǔ)知識(shí)）
Sub 新建表格寫入數(shù)據(jù)()
ActiveDocument.Tables(1).Delete
Set tb = ActiveDocument.Tables.Add(Selection.Range, 1, 3)
With tb
.Style = “網(wǎng)格型”
.Cell(1, 1).Range = “編號(hào)”
.Cell(1, 2).Range = “文件名”
.Cell(1, 3).Range = “擴(kuò)展名”
.Rows.Last.Select
Selection.InsertRowsBelow 1
With .Rows.Last
.Cells(1).Range = 1
.Cells(2).Range = 2
.Cells(3).Range = 3
End With
End With
End Sub
代碼運(yùn)行效果如下：
