利用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