【因本人有實際工作需要整理的代碼，這里貼一個簡單的框架用作筆記，同時提供給有需求的朋友。】

通過“試題庫轉Word版本”這樣一個應用實例，學習VBA在和Word數據交互處理中的應用。本代碼是運行在環境中，實現對Word的操作，與直接在Word中寫VBA代碼還是有些許區別的。

一、實例背景

實例：試題庫轉Word版本

素材：版本的試題庫，各章節的試題分別保存在不同的工作簿中，每章節包含單選題、多選題和判斷題三類題型（即每個工作薄中分別包含以上三類習題）。素材結果如下圖所示：

圖1：各章節試題工作簿

圖2：每章節試題樣式

目標：將各章節試題匯總，按照題型分類，分別保存到Word文檔中，基本格式如下：

1.題干
A.選項
B.選項
C.選項
D.選項
試題難度：難
試題答案：ABC

要求對Word進行基本的排版，包含對試題進行編號、字體及字號設置等。

二、VBA實現說明

手工操作需要重復大量的復制粘貼操作，人工耗費大且效率低下。VBA不僅能用于處理數據，同樣可以處理Word內容，進行排版等操作。因此，借助VBA工具作為橋梁，實現與Word數據交互處理，提高工作效率。

下面，通過代碼分解說明具體實現過程。

1.創建Word 對象引用并新建空白文檔

VBA對于的處理比較簡單，之前也有介紹，這里不作過多說明。主要介紹如何處理Word對象，第一個問題就是建立一個對Word 對象的引用。

????'創建word應用對象
????Dim?WordApp?As?Object
????Set?WordApp?=?CreateObject("Word.Application")

????'創建word文檔對象，并新建文檔
????Dim?SinDoc?As?Object
????Set?SinDoc?=?WordApp.documents.Add

2.向Word文檔中插入文字內容

以上代碼實現了Word 對象的應用，并創建了一個新的空白文檔。接下來，就要往該文檔中插入內容。

????Dim?SinC?As?Object
????Set?SinC?=?SinDoc.Content

????'插入內容
????SinC.InsertAfter?"測試內容"?&?vbCrLf
????SinC.InsertParagraphAfter

通過..的方式在文檔末尾插入內容，其中表示插入一個換行符（相當于回車）；通過..的方式在文檔末尾添加一個空段落（相當于兩次回車）。

3.段落格式調整

以上基本簡單介紹了如何新建Word 對象的引用，新建空白文檔及文字內容插入等方法，接下來要做的事情就是格式調整，這里僅介紹簡單的格式調整，包括字體、字號、段落對齊方式及段落首行縮進。

Sub?SetFont(ChosedDoc,?FontName,?FontSize,?Optional?Alig?=?0,?Optional?Inde?=?2)

????With?ChosedDoc.Paragraphs(ChosedDoc.Paragraphs.Count).Range
????????.Font.Name?=?FontName?'字體
????????.Font.Size?=?FontSize?'字號
????????.ParagraphFormat.Alignment?=?Alig?'對齊方式
????????.ParagraphFormat.CharacterUnitFirstLineIndent?=?Inde?'首行縮進
????End?With

End?Sub

為了排版美觀，對題干及選項等文字內容設置不同的格式，所以對段落格式調整比較頻繁，幾乎每次插入都需要設置該段落的格式，因此將段落格式調整單獨寫進了一個函數，并且包含兩個默認參數。對齊方式：0表示左對齊，1表示居中對齊，2表示右對齊。首行縮進，直接指定縮進量，一般為2，即兩個空格。

以上就是本實例中所有涉及到的對Word對象的操作，剩余的就是針對問題場景的解決方案流程設計，沒有太多新鮮的東西。

三、VBA排版結果1.VBA排版前后文件

如圖3是運行前素材，我們將各章節試題庫放在文件夾“試題”下，工作簿“試題轉word工具代碼 - v1.0.et”中包含所需的VBA代碼。運行該段代碼后，得到如圖4的結果，相比運行前，多了三個Word文檔，分別保存單選題、多選題和判斷題。

圖3：運行前素材

圖4：運行后結果2.排版效果及前后對比

首先，我們先看一下排版前試題庫內容及格式，如圖5-8：

圖5：第1章 地理題

圖6：第2章 人文題

圖7：第3章 數學題

排版后的效果：

圖8：單選題排版效果

圖9：多選題排版效果

圖10：判斷題排版效果

排版結果目前還比較簡單，主要是沒有在代碼中深加工，完全可以根據自己的需求進行深加工。

四、附代碼

運行該段代碼前，請務必將正在編輯的Word文檔保存，以免內容丟失。或者注釋掉.Quit。

Option?Explicit

'======================================
'作者：劉**；
'日期：2019-04-22；
'功能：Excel題庫轉Word版本；
'======================================

Public?Sub?ExcelToWord()

    '創建word應用對象
????Dim?WordApp?As?Object
????Set?WordApp?=?CreateObject("Word.Application")
????WordApp.Visible?=?True

????'創建word文檔對象，并新建文檔
????Dim?SinDoc?As?Object,?MulDoc?As?Object,?JudDoc?As?Object
????Set?SinDoc?=?WordApp.documents.Add
????Set?MulDoc?=?WordApp.documents.Add
????Set?JudDoc?=?WordApp.documents.Add

????Dim?SinC?As?Object,?MulC?As?Object,?JudC?As?Object
????Set?SinC?=?SinDoc.Content
????Set?MulC?=?MulDoc.Content
????Set?JudC?=?JudDoc.Content

????'插入標題，設置格式
????Call?SetFont(SinDoc,?"黑體",?18,?1)
????SinC.InsertAfter?"單選題"?&?vbCrLf
????SinC.InsertParagraphAfter

????Call?SetFont(MulDoc,?"黑體",?18,?1)
????MulC.InsertAfter?"多選題"?&?vbCrLf
????MulC.InsertParagraphAfter

????Call?SetFont(JudDoc,?"黑體",?18,?1)
????JudC.InsertAfter?"判斷題"?&?vbCrLf
????JudC.InsertParagraphAfter

????'Excel試題文件對象
????Dim?QuenWb?As?Workbook,?QuenSht?As?Worksheet
????Dim?FileName?As?String
????FileName?=?Dir(ThisWorkbook.Path?&?"/"?&?"Excel試題"?&?"/"?&?"*.et")

????'統計各類試題題目數（用以添加題號）
????Dim?SinNum?As?Integer,?MulNum?As?Integer,?JudNum?As?Integer
????SinNum?=?1
????MulNum?=?1
????JudNum?=?1

????'一些循環變量
????Dim?TotalRows?As?Integer,?i?As?Integer,?j?As?Integer,?loc?As?Byte

????'聲明試題類型、試題內容、答案等對象
????Dim?QuenType?As?String,?QuenStr?As?String,?Answer?As?String

????'循環處理Excel試題文件（支持多文件試題匯總處理）
????Do?While?FileName?<>?""

????????'Excel試題文件
????????Workbooks.Open?ThisWorkbook.Path?&?"/"?&?"Excel試題"?&?"/"?&?FileName,?ReadOnly:=True
????????Set?QuenWb?=?ActiveWorkbook
????????Set?QuenSht?=?QuenWb.Sheets(1)
????????TotalRows?=?QuenSht.UsedRange.Rows.Count?'Excel文件已使用行數

????????'循環處理行
????????For?i?=?1?To?TotalRows

????????????'獲取并判斷試題類型
????????????QuenType?=?QuenSht.Range("A"?&?i).Value
????????????On?Error?Resume?Next
????????????loc?=?0?'初始化，避免保留上次殘留值
????????????loc?=?WorksheetFunction.Match(QuenType,?Array("判斷題",?"單選題",?"多選題"),?0)
????????????On?Error?GoTo?0

????????????'非試題標記，跳過不處理
????????????If?loc?=?0?Then
????????????????GoTo?nexti
????????????End?If

????????????'處理答案內容，將數字標記替換為字母（或對錯）
????????????Answer?=?QuenSht.Range("D"?&?i).Value
????????????If?QuenType?<>?"判斷題"?Then
????????????????Answer?=?Replace(Answer,?"1",?"A")
????????????????Answer?=?Replace(Answer,?"2",?"B")
????????????????Answer?=?Replace(Answer,?"3",?"C")
????????????????Answer?=?Replace(Answer,?"4",?"D")
????????????Else
????????????????Answer?=?Replace(Answer,?"1",?"√")
????????????????Answer?=?Replace(Answer,?"2",?"×")
????????????End?If

????????????'根據不同試題類型，依次處理
????????????If?QuenType?=?"單選題"?Then
????????????????'設置字體格式（試題標題格式）
????????????????Call?SetFont(SinDoc,?"黑體",?12)
????????????????'插入試題標題
????????????????QuenStr?=?SinNum?&?"."?&?QuenSht.Range("C"?&?i).Value?&?vbCrLf
????????????????SinC.InsertAfter?QuenStr
????????????????'設置字體格式（標題之外內容）
????????????????Call?SetFont(SinDoc,?"楷體",?12)
????????????????'插入試題選項、難易程度、答案等內容
????????????????QuenStr?=?"A."?&?QuenSht.Range("E"?&?i).Value?&?vbCrLf?&?"B."?&?QuenSht.Range("F"?&?i).Value?&?vbCrLf?&?"C."?&?QuenSht.Range("G"?&?i).Value?&?vbCrLf?&?"D."?&?QuenSht.Range("H"?&?i).Value?&?vbCrLf?_
??????????????????????????&?"難易程度:"?&?QuenSht.Range("B"?&?i).Value?&?vbCrLf?_
??????????????????????????&?"試題答案："?&?Answer?&?vbCrLf
????????????????SinC.InsertAfter?QuenStr
????????????????SinC.InsertParagraphAfter?'插入空白段落
????????????????'該類型題目數量加1
????????????????SinNum?=?SinNum?+?1

????????????ElseIf?QuenType?=?"多選題"?Then

????????????????Call?SetFont(MulDoc,?"黑體",?12)
????????????????QuenStr?=?MulNum?&?"."?&?QuenSht.Range("C"?&?i).Value?&?vbCrLf
????????????????MulC.InsertAfter?QuenStr

????????????????Call?SetFont(MulDoc,?"楷體",?12)
????????????????QuenStr?=?"A."?&?QuenSht.Range("E"?&?i).Value?&?vbCrLf?&?"B."?&?QuenSht.Range("F"?&?i).Value?&?vbCrLf?&?"C."?&?QuenSht.Range("G"?&?i).Value?&?vbCrLf?&?"D."?&?QuenSht.Range("H"?&?i).Value?&?vbCrLf?_
??????????????????????????&?"難易程度:"?&?QuenSht.Range("B"?&?i).Value?&?vbCrLf?_
??????????????????????????&?"試題答案："?&?Answer?&?vbCrLf
????????????????MulC.InsertAfter?QuenStr
????????????????MulC.InsertParagraphAfter

????????????????MulNum?=?MulNum?+?1

????????????ElseIf?QuenType?=?"判斷題"?Then

????????????????Call?SetFont(JudDoc,?"黑體",?12)
????????????????QuenStr?=?JudNum?&?"."?&?QuenSht.Range("C"?&?i).Value?&?"（?）"?&?vbCrLf
????????????????JudC.InsertAfter?QuenStr

????????????????Call?SetFont(JudDoc,?"楷體",?12)
????????????????QuenStr?=?"難易程度:"?&?QuenSht.Range("B"?&?i).Value?&?vbCrLf?_
??????????????????????????&?"試題答案："?&?Answer?&?vbCrLf
????????????????JudC.InsertAfter?QuenStr
????????????????JudC.InsertParagraphAfter

????????????????JudNum?=?JudNum?+?1

????????????Else
????????????????MsgBox?"出錯！請檢查題目類型"?&?"“"?&?QuenType?&?"”"?&?"是否為預期內容！"?'正常情況下此句不會執行
????????????End?If

nexti:????????????Next?i

????????'關閉Excel試題文件
????????QuenWb.Close

????????'下一個Excel試題文件
????????FileName?=?Dir

????Loop

????'保存并關閉word文檔
????SinDoc.SaveAs?ThisWorkbook.Path?&?"/"?&?"單選題.wps"
????MulDoc.SaveAs?ThisWorkbook.Path?&?"/"?&?"多選題.wps"
????JudDoc.SaveAs?ThisWorkbook.Path?&?"/"?&?"判斷題.wps"
????SinDoc.Close
????MulDoc.Close
????JudDoc.Close

????'退出word應用
????WordApp.Quit

End?Sub


'設置段落格式
Sub?SetFont(ChosedDoc,?FontName,?FontSize,?Optional?Alig?=?0,?Optional?Inde?=?2)

????With?ChosedDoc.Paragraphs(ChosedDoc.Paragraphs.Count).Range
????????.Font.Name?=?FontName?'字體
????????.Font.Size?=?FontSize?'字號
????????.ParagraphFormat.Alignment?=?Alig?'對齊方式
????????.ParagraphFormat.CharacterUnitFirstLineIndent?=?Inde?'首行縮進
????End?With

End?Sub