vb.net教程 https://www.xin3721.com/eschool/vbnetxin3721/
https://www.xin3721.com/eschool/vbnetxin3721/
 
 
   1Public 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
 624

 
                

















