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