zoukankan      html  css  js  c++  java
  • 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 IntegerByVal sent As Integer)
     
    23        oRange = oDocument.Paragraphs(para).Range.Sentences(sent)
     
    24        oRange.Select()
     
    25    End Sub
     
    26    Public Sub SetRange(ByVal startpoint As IntegerByVal endpoint As IntegerByVal 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 StringByVal 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 = 0Then
    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 StringByVal 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 = 0Then
    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 = 0Then
    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 IntegerByVal 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 = 0Then
    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 StringAs 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 StringByVal 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 StringByRef bo As BooleanAs 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, 1Len(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 StringAs 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(11).Range
    440        oRange.Select()
    441
    442    End Sub
    443    '转到表格的某个单元格
    444    Public Sub GotoTableCell(ByVal ntable As IntegerByVal nRow As IntegerByVal 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, FalseTrue, 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 IntegerAs String
    515        Dim result As String = "一百"
    516        Dim a1, a2 As Integer
    517        Dim strs() As String = {""""""""""""""""""""""}
    518        If (a <= 10Then
    519            result = strs(a)
    520        ElseIf (a < 100Then
    521            a1 = a / 10
    522            a2 = a Mod 10
    523            If (a = 1Then
    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 IntegerByVal initrow As IntegerByVal 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 >= 1Then
    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 >= 1Then
    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 IntegerByVal initrow As IntegerByVal intcol As IntegerByVal 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 >= 1Then
    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 >= 1Then
    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 IntegerByVal intcol As IntegerAs 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
  • 相关阅读:
    Ghost博客安装
    PHP变量作用域
    ssh文件传输命令:sz与rz命令
    excel怎么固定第一行
    memcache和redis区别
    Memcache分布式部署方案
    Memcache服务器端参数说明
    Memcache基础教程
    在Windows下安装Memcached
    MySQL体系结构和存储引擎概述
  • 原文地址:https://www.cnblogs.com/lizunicon/p/1247304.html
Copyright © 2011-2022 走看看