vba

艺术字:    
  ActiveDocument.Shapes(i).Type   =   msoTextEffect   '   文档中的第i个Shape是否为艺术字  
   
  超级链接:    
  ActiveDocument.Hyperlinks.Count     '   文档中的超级链接的个数  
   
  首行是否缩进:    
  ActiveDocument.Paragraphs(i).FirstLineIndent     '   首行缩进的磅数  
   
  第一段头两个字是否下沉两行:    
  ActiveDocument.Paragraphs(1).DropCap.Position   =   wdDropNone     '   没有下沉  
  ActiveDocument.Paragraphs(1).DropCap.LinesToDrop     '   如果下沉的话,   则为下沉的行数

 

 

Public Class WordOpLib
  2
  3
  4    Private oWordApplic As Word.ApplicationClass
  5    Private oDocument As Word.Document
  6    Private oRange As Word.Range
  7    Private oShape As Word.Shape
  8    Private oSelection As Word.Selection
  9
 10
 11    Public Sub New()
 12        '激活com  word接口
 13        oWordApplic = New Word.ApplicationClass
 14        oWordApplic.Visible = False
 15
 16    End Sub
 17    '设置选定文本
 18    Public Sub SetRange(ByVal para As Integer)
 19        oRange = oDocument.Paragraphs(para).Range
 20        oRange.Select()
 21    End Sub
 22    Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)
 23        oRange = oDocument.Paragraphs(para).Range.Sentences(sent)
 24        oRange.Select()
 25    End Sub
 26    Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)
 27        If flag = True Then
 28            oRange = oDocument.Range(startpoint, endpoint)
 29            oRange.Select()
 30        Else
 31
 32        End If
 33    End Sub
 34
 35    '生成空的新文档
 36    Public Sub NewDocument()
 37        Dim missing = System.Reflection.Missing.Value
 38        Dim isVisible As Boolean = True
 39        oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)
 40        oDocument.Activate()
 41    End Sub
 42    '使用模板生成新文档
 43    Public Sub NewDocWithModel(ByVal FileName As String)
 44        Dim missing = System.Reflection.Missing.Value
 45        Dim isVisible As Boolean = False
 46        Dim strName As String
 47        strName = FileName
 48        oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)
 49        oDocument.Activate()
 50    End Sub
 51    '打开已有文档
 52    Public Sub OpenFile(ByVal FileName As String)
 53        Dim strName As String
 54        Dim isReadOnly As Boolean
 55        Dim isVisible As Boolean
 56        Dim missing = System.Reflection.Missing.Value
 57
 58        strName = FileName
 59        isReadOnly = False
 60        isVisible = True
 61
 62        oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
 63        oDocument.Activate()
 64
 65    End Sub
 66    Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)
 67        Dim strName As String
 68        Dim isVisible As Boolean
 69        Dim missing = System.Reflection.Missing.Value
 70
 71        strName = FileName
 72        isVisible = True
 73
 74        oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
 75        oDocument.Activate()
 76    End Sub
 77    '退出Word
 78    Public Sub Quit()
 79        Dim missing = System.Reflection.Missing.Value
 80        oWordApplic.Quit()
 81        System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)
 82        oWordApplic = Nothing
 83    End Sub
 84    '关闭所有打开的文档
 85    Public Sub CloseAllDocuments()
 86        oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
 87    End Sub
 88    '关闭当前的文档
 89    Public Sub CloseCurrentDocument()
 90
 91        oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
 92    End Sub
 93    '保存当前文档
 94    Public Sub Save()
 95        Try
 96            oDocument.Save()
 97        Catch
 98            MsgBox(Err.Description)
 99        End Try
100    End Sub
101    '另存为文档
102    Public Sub SaveAs(ByVal FileName As String)
103        Dim strName As String
104        Dim missing = System.Reflection.Missing.Value
105
106        strName = FileName
107
108        oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
109    End Sub
110    '保存为Html文件
111    Public Sub SaveAsHtml(ByVal FileName As String)
112        Dim missing = System.Reflection.Missing.Value
113        Dim strName As String
114
115        strName = FileName
116        Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)
117
118        oDocument.SaveAs(strName, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
119    End Sub
120    '插入文本
121    Public Sub InsertText(ByVal text As String)
122        oWordApplic.Selection.TypeText(text)
123    End Sub
124    '插入一个空行
125    Public Sub InsertLineBreak()
126        oWordApplic.Selection.TypeParagraph()
127    End Sub
128    '插入指定行数的空行
129    Public Sub InsertLineBreak(ByVal lines As Integer)
130        Dim i As Integer
131        For i = 1 To lines
132            oWordApplic.Selection.TypeParagraph()
133        Next
134    End Sub
135    '插入表格
136    Public Sub InsertTable(ByRef table As DataTable)
137        Dim oTable As Word.Table
138        Dim rowIndex, colIndex, NumRows, NumColumns As Integer
139        rowIndex = 1
140        colIndex = 0
141        If (table.Rows.Count = 0) Then
142            Exit Sub
143        End If
144
145        NumRows = table.Rows.Count + 1
146        NumColumns = table.Columns.Count
147        oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
148
149
150        '初始化列
151        Dim Row As DataRow
152        Dim Col As DataColumn
153        'For Each Col In table.Columns
154        '    colIndex = colIndex + 1
155        '    oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
156        'Next
157
158        '将行添入表格
159        For Each Row In table.Rows
160            rowIndex = rowIndex + 1
161            colIndex = 0
162            For Each Col In table.Columns
163                colIndex = colIndex + 1
164                oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
165            Next
166        Next
167        oTable.Rows(1).Delete()
168        oTable.AllowAutoFit = True
169        oTable.ApplyStyleFirstColumn = True
170        oTable.ApplyStyleHeadingRows = True
171
172    End Sub
173    '插入表格(修改为在原有表格的基础上添加数据)
174    Public Sub InsertTable2(ByRef table As DataTable, ByVal strbmerge As String, ByVal totalrow As Integer)
175        Dim oTable As Word.Table
176        Dim rowIndex, colIndex, NumRows, NumColumns As Integer
177        Dim strm() As String
178        Dim i As Integer
179        rowIndex = 1
180        colIndex = 0
181
182        If (table.Rows.Count = 0) Then
183            Exit Sub
184        End If
185
186        NumRows = table.Rows.Count + 1
187        NumColumns = table.Columns.Count
188        'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
189
190
191        '初始化列
192        Dim Row As DataRow
193        Dim Col As DataColumn
194        'For Each Col In table.Columns
195        '    colIndex = colIndex + 1
196        '    oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
197        'Next
198
199        '将行添入表格
200        For Each Row In table.Rows
201            colIndex = 0
202            GotoRightCell()
203            oWordApplic.Selection.InsertRows(1)
204            For Each Col In table.Columns
205                GotoRightCell()
206                colIndex = colIndex + 1
207                Try
208                    oWordApplic.Selection.TypeText(Row(Col.ColumnName))
209                Catch ex As Exception
210                    oWordApplic.Selection.TypeText(" ")
211                End Try
212                'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
213            Next
214        Next
215        '如果strbmerge不为空.则要合并相应的行和列
216        If strbmerge.Trim().Length <> 0 Then
217            strm = strbmerge.Split(";")
218            For i = 1 To strm.Length - 1
219                If strm(i).Split(",").Length = 2 Then
220                    MergeDouble(totalrow, strm(0), strm(i).Split(",")(1), strm(i).Split(",")(0))
221                End If
222                MergeSingle(totalrow, strm(0), strm(i))
223            Next
224        End If
225        '删除可能多余的一行
226        'GotoRightCell()
227        'GotoDownCell()
228        'oWordApplic.Selection.Rows.Delete()
229        'oTable.AllowAutoFit = True
230        'oTable.ApplyStyleFirstColumn = True
231        'oTable.ApplyStyleHeadingRows = True
232    End Sub
233    '插入表格(专门适应工程结算工程量清单)
234    Public Sub InsertTableQD(ByRef table As DataTable, ByRef table1 As DataTable)
235        Dim oTable As Word.Table
236        Dim rowIndex, colIndex, NumRows, NumColumns As Integer
237        Dim xmmc As String
238        Dim i As Integer
239        Dim j As Integer
240        rowIndex = 1
241        colIndex = 0
242
243        If (table.Rows.Count = 0) Then
244            Exit Sub
245        End If
246
247        NumRows = table.Rows.Count + 1
248        NumColumns = table.Columns.Count
249        'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
250
251
252        '初始化列
253        Dim Row As DataRow
254        Dim rowtemp As DataRow
255        Dim row1() As DataRow
256        Dim Col As DataColumn
257        Dim coltemp As DataColumn
258        'For Each Col In table.Columns
259        '    colIndex = colIndex + 1
260        '    oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
261        'Next
262
263        '将行添入表格
264        For Each Row In table.Rows
265            colIndex = 0
266            xmmc = Row("项目名称")
267            GotoRightCell()
268            oWordApplic.Selection.InsertRows(1)
269            For Each Col In table.Columns
270                GotoRightCell()
271                Try
272                    If (Col.ColumnName = "项目序号") Then
273                        oWordApplic.Selection.TypeText(intToUpint(Val(Row(Col.ColumnName))))
274                    Else
275                        oWordApplic.Selection.TypeText(Row(Col.ColumnName))
276                    End If
277                Catch ex As Exception
278                    oWordApplic.Selection.TypeText(" ")
279                End Try
280                'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
281            Next
282            row1 = table1.Select("项目名称='" + xmmc + "'")
283
284            For i = 0 To row1.Length - 1
285                GotoRightCell()
286                oWordApplic.Selection.InsertRows(1)
287                For j = 0 To table1.Columns.Count - 1
288                    If (table1.Columns(j).ColumnName <> "项目名称") Then
289                        GotoRightCell()
290                        Try
291                            oWordApplic.Selection.TypeText(row1(i)(j))
292                        Catch ex As Exception
293                            oWordApplic.Selection.TypeText(" ")
294                        End Try
295                    End If
296                    'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
297                Next
298            Next
299
300
301
302        Next
303        '删除可能多余的一行
304        'GotoRightCell()
305        'GotoDownCell()
306        'oWordApplic.Selection.Rows.Delete()
307        'oTable.AllowAutoFit = True
308        'oTable.ApplyStyleFirstColumn = True
309        'oTable.ApplyStyleHeadingRows = True
310    End Sub
311    '插入表格,为了满足要求,在中间添加一根竖线
312    Public Sub InsertTable3(ByRef table As DataTable, ByVal introw As Integer, ByVal intcol As Integer)
313        Dim rowIndex, colIndex, NumRows, NumColumns As Integer
314        Dim Row As DataRow
315        Dim Col As DataColumn
316        If (table.Rows.Count = 0) Then
317            Exit Sub
318        End If
319        '首先是拆分选中的单元格
320        oDocument.Tables(1).Cell(introw, 3).Split(table.Rows.Count, 2)
321        '选中初始的单元格
322        oDocument.Tables(1).Cell(introw, 3).Select()
323        '将行添入表格
324        For Each Row In table.Rows
325            Try
326                oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(Row(0))
327                oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(Row(1))
328            Catch ex As Exception
329                oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(" ")
330                oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(" ")
331            End Try
332            introw = introw + 1
333        Next
334    End Sub
335    '设置对齐
336    Public Sub SetAlignment(ByVal strType As String)
337        Select Case strType
338            Case "center"
339                oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
340            Case "left"
341                oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
342            Case "right"
343                oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight
344            Case "justify"
345                oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify
346        End Select
347    End Sub
348    '设置字体
349    Public Sub SetStyle(ByVal strFont As String)
350        Select Case strFont
351            Case "bold"
352                oWordApplic.Selection.Font.Bold = 1
353            Case "italic"
354                oWordApplic.Selection.Font.Italic = 1
355            Case "underlined"
356                oWordApplic.Selection.Font.Subscript = 1
357        End Select
358    End Sub
359    '取消字体风格
360    Public Sub DissableStyle()
361        oWordApplic.Selection.Font.Bold = 0
362        oWordApplic.Selection.Font.Italic = 0
363        oWordApplic.Selection.Font.Subscript = 0
364    End Sub
365    '设置字体字号
366    Public Sub SetFontSize(ByVal nSize As Integer)
367        oWordApplic.Selection.Font.Size = nSize
368    End Sub
369    '跳过本页
370    Public Sub InsertPageBreak()
371        Dim pBreak As Integer
372        pBreak = CInt(Word.WdBreakType.wdPageBreak)
373        oWordApplic.Selection.InsertBreak(pBreak)
374    End Sub
375    '转到书签
376    Public Sub GotoBookMark(ByVal strBookMark As String)
377        Dim missing = System.Reflection.Missing.Value
378        Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)
379        oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)
380    End Sub
381    '判断书签是否存在
382    Public Function BookMarkExist(ByVal strBookMark As String) As Boolean
383        Dim Exist As Boolean
384        Exist = oDocument.Bookmarks.Exists(strBookMark)
385        Return Exist
386    End Function
387    '替换书签的内容
388    Public Sub ReplaceBookMark(ByVal icurnum As String, ByVal strcontent As String)
389        strcontent = strcontent.Replace("0:00:00", "")
390        oDocument.Bookmarks(icurnum).Select()
391        oWordApplic.Selection.TypeText(strcontent)
392    End Sub
393
394    '得到书签的名称
395    Public Function GetBookMark(ByVal icurnum As String, ByRef bo As Boolean) As String
396        Dim strReturn As String
397        If Right(oDocument.Bookmarks(icurnum).Name, 5) = "TABLE" Then
398            bo = True
399            Dim strTemp As String
400            strTemp = oDocument.Bookmarks(icurnum).Name()
401            strReturn = Mid(strTemp, 1, Len(strTemp) - 5)
402        Else
403            bo = False
404            strReturn = oDocument.Bookmarks(icurnum).Name
405        End If
406        Return strReturn
407    End Function
408    '得到书签的名称
409    Public Function GetBookMark1(ByVal icurnum As String) As String
410        Return oDocument.Bookmarks(icurnum).Name
411    End Function
412    '转到文档结尾
413    Public Sub GotoTheEnd()
414        Dim missing = System.Reflection.Missing.Value
415        Dim unit = Word.WdUnits.wdStory
416        oWordApplic.Selection.EndKey(unit, missing)
417    End Sub
418    '转到文档开头
419    Public Sub GotoTheBegining()
420        Dim missing = System.Reflection.Missing.Value
421        Dim unit = Word.WdUnits.wdStory
422        oWordApplic.Selection.HomeKey(unit, missing)
423    End Sub
424    '删除多余的一行
425    Public Sub DelUnuseRow()
426        oWordApplic.Selection.Rows.Delete()
427    End Sub
428    '转到表格
429    Public Sub GotoTheTable(ByVal ntable As Integer)
430        'Dim missing = System.Reflection.Missing.Value
431        'Dim what = Word.WdGoToItem.wdGoToTable
432        'Dim which = Word.WdGoToDirection.wdGoToFirst
433        'Dim count = ntable
434
435        'oWordApplic.Selection.GoTo(what, which, count, missing)
436        'oWordApplic.Selection.ClearFormatting()
437
438        'oWordApplic.Selection.Text = ""
439        oRange = oDocument.Tables(ntable).Cell(1, 1).Range
440        oRange.Select()
441
442    End Sub
443    '转到表格的某个单元格
444    Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)
445        oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range
446        oRange.Select()
447    End Sub
448    '表格中转到右面的单元格
449    Public Sub GotoRightCell()
450        Dim missing = System.Reflection.Missing.Value
451        Dim direction = Word.WdUnits.wdCell
452        oWordApplic.Selection.MoveRight(direction, missing, missing)
453    End Sub
454    '表格中转到左面的单元格
455    Public Sub GotoLeftCell()
456        Dim missing = System.Reflection.Missing.Value
457        Dim direction = Word.WdUnits.wdCell
458        oWordApplic.Selection.MoveLeft(direction, missing, missing)
459    End Sub
460    '表格中转到下面的单元格
461    Public Sub GotoDownCell()
462        Dim missing = System.Reflection.Missing.Value
463        Dim direction = Word.WdUnits.wdCell
464        oWordApplic.Selection.MoveDown(direction, missing, missing)
465    End Sub
466    '表格中转到上面的单元格
467    Public Sub GotoUpCell()
468        Dim missing = System.Reflection.Missing.Value
469        Dim direction = Word.WdUnits.wdCell
470        oWordApplic.Selection.MoveUp(direction, missing, missing)
471    End Sub
472    '文档中所有的书签总数
473    Public Function TotalBkM() As Integer
474        Return oDocument.Bookmarks.Count
475    End Function
476    '选中书签
477    Public Sub SelectBkMk(ByVal strName As String)
478        oDocument.Bookmarks.Item(strName).Select()
479    End Sub
480    '插入图片
481    Public Sub InsertPic(ByVal FileName As String)
482        Dim missing = System.Reflection.Missing.Value
483        oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing).Select()
484        oShape = oWordApplic.Selection.InlineShapes(1).ConvertToShape
485        oWordApplic.Selection.WholeStory()
486        oShape.ZOrder(Microsoft.Office.Core.MsoZOrderCmd.msoSendBehindText)
487    End Sub
488    '统一调整图片的位置.也就是往上面调整图片一半的高度
489    Public Sub SetCurPicHei()
490        Dim e As Word.Shape
491        For Each e In oDocument.Shapes
492            oDocument.Shapes(e.Name).Select()
493            oWordApplic.Selection.ShapeRange.RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage
494            oWordApplic.Selection.ShapeRange.RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionParagraph
495            oWordApplic.Selection.ShapeRange.LockAnchor = True
496            'oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes(e.Name).Height)
497        Next
498    End Sub
499
500    Public Sub SetCurPicHei1()
501        Dim e As Word.Shape
502        For Each e In oDocument.Shapes
503            oDocument.Shapes(e.Name).Select()
504            oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes(e.Name).Height / 2)
505        Next
506    End Sub
507    Public Sub SetCurPicHei2()
508        Dim e As Word.Shape
509        For Each e In oDocument.Shapes
510            oDocument.Shapes(e.Name).Select()
511            oWordApplic.Selection.ShapeRange.IncrementTop(-oDocument.Shapes(e.Name).Height / 2)
512        Next
513    End Sub
514    Public Function intToUpint(ByVal a As Integer) As String
515        Dim result As String = "一百"
516        Dim a1, a2 As Integer
517        Dim strs() As String = {"零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}
518        If (a <= 10) Then
519            result = strs(a)
520        ElseIf (a < 100) Then
521            a1 = a / 10
522            a2 = a Mod 10
523            If (a = 1) Then
524                result = "十" + strs(a2)
525            End If
526        Else
527            result = strs(a1) + "十" + strs(a2)
528        End If
529        Return result
530    End Function
531    '合并没有参照的某一列,一般来讲对应第一列
532    'itotalrow 总行数
533    'initrow   初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0
534    'intcol    列数
535    Public Sub MergeSingle(ByVal itotalrow As Integer, ByVal initrow As Integer, ByVal intcol As Integer)
536        oDocument.Tables(1).Cell(initrow + 1, intcol).Select()
537        Dim irow As Integer      '当前行数
538        Dim strValue As String   '循环比较的行初值
539        Dim i As Integer
540        Dim direction = Word.WdUnits.wdLine
541        Dim extend = Word.WdMovementType.wdExtend
542
543        i = 0
544        irow = 1 + initrow '初始值为1
545        For i = 2 + initrow To itotalrow + initrow
546
547            strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text
548            If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) Then
549                '这是对最后一次处理的特殊情况.
550                If (i = itotalrow + initrow) Then
551                    oWordApplic.Selection.MoveDown(direction, (i - irow), extend)
552                    If (i - irow >= 1) Then
553                        oWordApplic.Selection.Cells.Merge()
554                    End If
555                    oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue
556                End If
557            Else
558                oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)
559                If (i - irow - 1 >= 1) Then
560                    oWordApplic.Selection.Cells.Merge()
561                End If
562                oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue
563                irow = i
564                oDocument.Tables(1).Cell(irow, intcol).Select()
565            End If
566        Next i
567    End Sub
568    '合并有参照的某一列
569    'itotalrow 总行数
570    'initrow   初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0
571    'intcol    列数
572    'basecol   参照合并的那一列
573    Public Sub MergeDouble(ByVal itotalrow As Integer, ByVal initrow As Integer, ByVal intcol As Integer, ByVal basecol As Integer)
574        oDocument.Tables(1).Cell(initrow + 1, intcol).Select()
575        Dim irow As Integer      '当前行数
576        Dim strValue As String   '循环比较的行初值
577        Dim i As Integer
578        Dim direction = Word.WdUnits.wdLine
579        Dim extend = Word.WdMovementType.wdExtend
580
581        i = 0
582        irow = 1 + initrow '初始值为1
583        For i = 2 + initrow To itotalrow + initrow
584
585            strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text
586            If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) And (getdata(i, basecol) = getdata(irow, basecol)) Then
587                '这是对最后一次处理的特殊情况.
588                If (i = itotalrow + initrow) Then
589                    oWordApplic.Selection.MoveDown(direction, (i - irow), extend)
590                    If (i - irow >= 1) Then
591                        oWordApplic.Selection.Cells.Merge()
592                    End If
593                    oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue
594                End If
595            Else
596                oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)
597                If (i - irow - 1 >= 1) Then
598                    oWordApplic.Selection.Cells.Merge()
599                End If
600                oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue
601                irow = i
602                oDocument.Tables(1).Cell(irow, intcol).Select()
603            End If
604        Next i
605    End Sub
606    '得到某个单元的值,如果为空的话,有两种情况.
607    '其一：是一个合并的单元格，取其上面的值
608    '其二：该单元格本来就是空值
609    Public Function getdata(ByVal introw As Integer, ByVal intcol As Integer) As String
610        Try
611            If (oDocument.Tables(1).Cell(introw, intcol).Range.Text = "" Or (oDocument.Tables(1).Cell(introw, intcol).Range.Text = Nothing)) Then
612                getdata = getdata(introw - 1, intcol)
613            Else
614                getdata = oDocument.Tables(1).Cell(introw, intcol).Range.Text
615            End If
616        Catch ex As Exception
617            getdata = getdata(introw - 1, intcol)
618        End Try
619
620
621    End Function
622End Class
623