利用VBA處理Word以及WORD表格

 1.向WORD中建立表格並插入文字  
    本例的功能是在文檔開頭插入一張   3   行   6   列的表格。可用For   Each...Next   結構來迴圈遍曆表格中的每個儲存格。在   For   Each...Next   結構中,InsertAfter   方法用來向表格儲存格添加文字("第   1   儲存格"、"   第   2   儲存格"等等),oTable.AutoFormat屬性用於指定表格套用格式。++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'準系統：插入一個3列6行的表格,並給每行表格插入資料
'引用組件：在工程中引用OR Microsoft Word X.0 object library才能使用word.application
'整理作者：FlashAsp
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim wd     As New Word.Application
wd.Documents.Add DocumentType:=wdNewBlankDocument
Set oDoc = wd.ActiveDocument
    Set oTable = oDoc.Tables.Add(Range:=oDoc.Range(Start:=0, End:=0), NumRows:=6, NumColumns:=3)
    iCount = 1
    For Each oCell In oTable.Range.Cells
    oCell.Range.InsertAfter "第 " & iCount & "儲存格"
    iCount = iCount + 1
    Next oCell
    oTable.AutoFormat Format:=wdTableFormatColorful2, ApplyBorders:=True, ApplyFont:=True, ApplyColor:=True
'將游標移到最後
wd.Selection.EndKey Unit:=wdStory
'插入分頁符
wd.Selection.InsertBreak Type:=wdPageBreak
wd.Visible = True
wd.ShowMe
Set wd = Nothing
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
2.在表格的列、行插入序號  
  　　1.   如果需要在表格的第一列插入序號,只需將   For   Each...Next   結構中的內容改為下述程式行即可,其中InsertAfter   方法用來向表格儲存格添加序號("第   1   行"、"   第2   行"等等)。  
  　　If   iCount   Mod   4   =   1   Then  
  　　　oCell.Range.InsertAfter"第   "   &   (iCount   -   1)   /   4   +   1   &   "   行"  
  　　End   If  
  　　iCount   =   iCount   +   1  
  　　2.   如果需要從表格的第二行開始插入序號,應將上述代碼改為:  
  　　If   iCount   Mod   4   =   1   And   iCount   >   4   Then  
  　　   oCell.Range.InsertAfter   "第   "&   (iCount   -   1)   /   4   &   "行"  
  　　End   If  
  　　iCount   =   iCount   +   1 
 
3.在表格的列插入日期  
  　　
    (1)如需在表格的第一列插入日期,   可用For   Each...Next結構來迴圈遍曆表格中的每個儲存格,當判斷某一儲存格為第一列時,插入日期。Formart(Date,...)用於指定日期的格式,下面例子中的日期從Date+1(即當前日期第二天)開始,使用者可以根據需要自訂。  
  　　Set   oDoc   =   ActiveDocument  
  　　Set   oTable   =oDoc.Tables.Add(Range:=oDoc.Range(Start:=0,End:=0),NumRows:=  
  4,NumColumns:=4)  
  　　iCount   =   1  
  　　For   Each   oCell   In   oTable.Range.Cells  
  　　If   iCount   Mod   4   =   1   And   iCount   >   4   Then  
  　　　   oCell.Range.InsertAfter   Format(Date   +   (iCount   -   1)   /   4,   "YYYY.MM.DD")  
  　　End   If  
  　　If   iCount   Mod   4   =   2   And   iCount   >   4   Then  
  　　　   oCell.Range.InsertAftercWeekName(WeekDay(Date+(iCount   -   1)   /   4))  
  　　End   If  
  　　iCount   =   iCount   +   1  
  　　   Next   oCell  
  　　   oTable.AutoFormat   Format:=wdTableFormatColorful1,ApplyBorders:=True,   Ap  
  plyFont:=True,   ApplyColor:=True  

  　　(2)   如果需要在表格的第二列插入星期值,可在上例的For   Each...Next結構中插入以下幾行:  
  　　If   iCount   Mod   4   =   2   And   iCount   >   4   Then  
  　　oCell.Range.InsertAfter   cWeekName(WeekDay(Date   +   (iCount   -   1)   /   4))  
  　　End   If  
  　　其中,WeekDay(Date)返回一數值(1～7),分別表示"星期日"～"星期六",CWeekName數組需要事先定義為:  
  　　Dim   cWeekName(7)  
  　　cWeekName(1)   =   "星期日"  
  　　cWeekName(2)   =   "星期一"     　
  　　cWeekName(7)   ="星期六"  

4.   根據儲存格的內容設定不同的格式  
  　　以上例中表格為例,如果需要將所有"星期六"和"星期日"所在行格式改為藍色背景,只要在上常式序之後追加以下幾行即可(表格格式改為wdTableFormatColorful2,行數改為12行)。程式中再次使用For   Each...Next結構遍曆表格中的每一行(Rows),如果檢測到某一行滿足條件("星期六"或"星期日"),則選擇一行(Selection.SelectRow),將其屬性改為需要的格式(本例中為藍色背景)。  
  　　iCount   =   1  
  　　For   Each   Rows   In   oTable.Range.Rows  
  　　If   (WeekDay(Date   +   (iCount   -   1))   =   7   Or   WeekDay(Date   +   (iCount   -   1))=   1)  
  And   iCount   >   1  
  　　   Then  
  　　　   Selection.SelectRow  
  　　　   With   Selection.Cells  
  　　With   .Shading  
  　　.Texture   =   wdTextureNone  
  　　.ForegroundPatternColorIndex   =   wdAuto  
  　　.BackgroundPatternColorIndex   =   wdBlue  
  　　End   With  
  　　　End   With  
  　　End   If  
  　　　iCount   =   iCount   +   1  
  　　　Selection.MoveDown   Unit:=wdLine,   Count:=1  
  　　　Next   Rows  

5.開啟一個預先定義好的WORD模板並替換模板中指定的某個字串
' ****************************************************************************************************
'引用組件：在工程中引用OR Microsoft Word X.0 object library才能使用word.application
'名稱：OpenWordAndReplaceChar(filename As String, ReplacedStr As String, ReplacementStr As String)
'功能：開啟一個預先定義好的WORD模板並替換模板中指定的某個字串
'調用： Call OpenWordAndReplaceChar("001.doc", "$1", "寶寶:)")
'參數：Filename:WORD檔案名稱,ReplacedStr:WORD中待替換的字元,ReplacementStr：程式中傳遞到WORD中的字串
'整理作者：FlashAsp
'******************************************************************************************************
Public Sub OpenWordAndReplaceChar(FileName As String, ReplacedStr As String, ReplacementStr As String)
Dim wordApp As New Word.Application
Dim wordArange As Word.Range
Dim wordSelection As Word.Selection
Dim ReplaceSign As Boolean
Dim i As Integer
FileName = App.Path & "/" & FileName
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
wordApp.Documents.Open (FileName)
Set wordSelection = wordApp.Selection
'指定檔案編輯位置
Set wordArange = wordApp.ActiveDocument.Range(0, 1)
'啟用編輯位置
wordArange.Select
'初始化是否替換成功標誌
If ReplacedStr <> " " And ReplacementStr <> "" Then
ReplaceSign = True
Do While ReplaceSign
ReplaceSign = wordArange.Find.Execute(ReplacedStr, MatchCase, , , , , , wdFindContinue, , ReplacementStr, True)
Loop
End If
'回到列印狀態
wordApp.ActiveWindow.View.Type = wdPrintView
End Sub