VB.NET操作WORD(VBA)

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

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值