|  | 
				
	
		
			
 			Posted on 
2008-03-21 16:24 
yunbo  
阅读(2048 ) 
评论() 
 
收藏 
举报 
 VB.NET操作WORD 
  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 
  |