之前我們分享了一期小代碼，内容是如何将word中表格的資料讀入excel……
之後有朋友表示知道了，又問如何将excel中的資料寫入word……
此時此刻，我再一次清醒的意識到，這世界上像我這樣好的人已經不多了。勉強害羞臉……
舉個例子還是。
下圖是一張excel表。
再下圖是word中的一張excel表
兩張表一個處于excel，一個處于word，但求同存異有一個非常重要的共同點：
表的布局是一緻的，标題的内容和位置一模一樣，比如标題都處在第一行等。
示例動畫如下：
在excel中使用以下小代碼可以将excel中的資料寫入word：
Sub ExcelTableToWord()
Dim WdApp As Object
Dim objTable As Object
Dim objDoc As Object
Dim strPath As String
Dim arr As Variant, brr As Variant
Dim k As Long, x As Long, y As Long
Dim i As Long, j As Long, Clny As Long
On Error Resume Next
Set WdApp = CreateObject("Word.Application")
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "Word檔案", "*.doc*", 1
'隻顯示word檔案
.AllowMultiSelect = False
'禁止多選檔案
If .Show Then strPath = .SelectedItems(1) Else Exit Sub
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
arr = [a1].CurrentRegion
'excel表格資料讀入數組arr
Set objDoc = WdApp.documents.Open(strPath)
'背景打開使用者標明的word文檔
For Each objTable In objDoc.tables
'周遊word中的表格
x = objTable.Rows.Count
y = objTable.Columns.Count
For j = 1 To y
'周遊表格的标題行，預設标題處于第一行
If Application.Clean(objTable.Cell(1, j).Range.Text) = arr(1, j) Then
'如果标題行一緻，則将excel表資料寫入word
For i = 2 To x
With objTable.Cell(i, j).Range
.Text = ""
.Text = arr(i, j)
End With
Next
End If
Next
Next
objDoc.Close True: WdApp.Quit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set objDoc = Nothing
Set WdApp = Nothing
MsgBox "處理完成。"
End Sub
小貼士：
某男和女朋友吵架冷戰了，想和好，但她不理，于是給她支付寶轉了520元，然後又轉1314元。
不久她發來一條資訊：有誠意的話，一句話不要分開兩次說。。。
圖文制作：看見星光
點選【閱讀原文】，拼了！