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