VB.NET操作WORD(VBA)

   1      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
622 End Class