VB.NET操作WORD1
Public Class WordOpLib2
3
4
Private oWordApplic As Word.ApplicationClass5
Private oDocument As Word.Document6
Private oRange As Word.Range7
Private oShape As Word.Shape8
Private oSelection As Word.Selection9
10
11
Public Sub New()12
'激活com word接口13
oWordApplic = New Word.ApplicationClass14
oWordApplic.Visible = False15
16
End Sub17
'设置选定文本18
Public Sub SetRange(ByVal para As Integer)19
oRange = oDocument.Paragraphs(para).Range20
oRange.Select()21
End Sub22
Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)23
oRange = oDocument.Paragraphs(para).Range.Sentences(sent)24
oRange.Select()25
End Sub26
Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)27
If flag = True Then28
oRange = oDocument.Range(startpoint, endpoint)29
oRange.Select()30
Else31
32
End If33
End Sub34
35
'生成空的新文档36
Public Sub NewDocument()37
Dim missing = System.Reflection.Missing.Value38
Dim isVisible As Boolean = True39
oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)40
oDocument.Activate()41
End Sub42
'使用模板生成新文档43
Public Sub NewDocWithModel(ByVal FileName As String)44
Dim missing = System.Reflection.Missing.Value45
Dim isVisible As Boolean = False46
Dim strName As String47
strName = FileName48
oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)49
oDocument.Activate()50
End Sub51
'打开已有文档52
Public Sub OpenFile(ByVal FileName As String)53
Dim strName As String54
Dim isReadOnly As Boolean55
Dim isVisible As Boolean56
Dim missing = System.Reflection.Missing.Value57
58
strName = FileName59
isReadOnly = False60
isVisible = True61
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 Sub66
Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)67
Dim strName As String68
Dim isVisible As Boolean69
Dim missing = System.Reflection.Missing.Value70
71
strName = FileName72
isVisible = True73
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 Sub77
'退出Word78
Public Sub Quit()79
Dim missing = System.Reflection.Missing.Value80
oWordApplic.Quit()81
System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)82
oWordApplic = Nothing83
End Sub84
'关闭所有打开的文档85
Public Sub CloseAllDocuments()86
oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)87
End Sub88
'关闭当前的文档89
Public Sub CloseCurrentDocument()90
91
oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)92
End Sub93
'保存当前文档94
Public Sub Save()95
Try96
oDocument.Save()97
Catch98
MsgBox(Err.Description)99
End Try100
End Sub101
'另存为文档102
Public Sub SaveAs(ByVal FileName As String)103
Dim strName As String104
Dim missing = System.Reflection.Missing.Value105
106
strName = FileName107
108
oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)109
End Sub110
'保存为Html文件111
Public Sub SaveAsHtml(ByVal FileName As String)112
Dim missing = System.Reflection.Missing.Value113
Dim strName As String114
115
strName = FileName116
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 Sub120
'插入文本121
Public Sub InsertText(ByVal text As String)122
oWordApplic.Selection.TypeText(text)123
End Sub124
'插入一个空行125
Public Sub InsertLineBreak()126
oWordApplic.Selection.TypeParagraph()127
End Sub128
'插入指定行数的空行129
Public Sub InsertLineBreak(ByVal lines As Integer)130
Dim i As Integer131
For i = 1 To lines132
oWordApplic.Selection.TypeParagraph()133
Next134
End Sub135
'插入表格136
Public Sub InsertTable(ByRef table As DataTable)137
Dim oTable As Word.Table138
Dim rowIndex, colIndex, NumRows, NumColumns As Integer139
rowIndex = 1140
colIndex = 0141
If (table.Rows.Count = 0) Then142
Exit Sub143
End If144
145
NumRows = table.Rows.Count + 1146
NumColumns = table.Columns.Count147
oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)148
149
150
'初始化列151
Dim Row As DataRow152
Dim Col As DataColumn153
'For Each Col In table.Columns154
' colIndex = colIndex + 1155
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)156
'Next157
158
'将行添入表格159
For Each Row In table.Rows160
rowIndex = rowIndex + 1161
colIndex = 0162
For Each Col In table.Columns163
colIndex = colIndex + 1164
oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))165
Next166
Next167
oTable.Rows(1).Delete()168
oTable.AllowAutoFit = True169
oTable.ApplyStyleFirstColumn = True170
oTable.ApplyStyleHeadingRows = True171
172
End Sub173
'插入表格(修改为在原有表格的基础上添加数据)174
Public Sub InsertTable2(ByRef table As DataTable, ByVal strbmerge As String, ByVal totalrow As Integer)175
Dim oTable As Word.Table176
Dim rowIndex, colIndex, NumRows, NumColumns As Integer177
Dim strm() As String178
Dim i As Integer179
rowIndex = 1180
colIndex = 0181
182
If (table.Rows.Count = 0) Then183
Exit Sub184
End If185
186
NumRows = table.Rows.Count + 1187
NumColumns = table.Columns.Count188
'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)189
190
191
'初始化列192
Dim Row As DataRow193
Dim Col As DataColumn194
'For Each Col In table.Columns195
' colIndex = colIndex + 1196
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)197
'Next198
199
'将行添入表格200
For Each Row In table.Rows201
colIndex = 0202
GotoRightCell()203
oWordApplic.Selection.InsertRows(1)204
For Each Col In table.Columns205
GotoRightCell()206
colIndex = colIndex + 1207
Try208
oWordApplic.Selection.TypeText(Row(Col.ColumnName))209
Catch ex As Exception210
oWordApplic.Selection.TypeText(" ")211
End Try212
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))213
Next214
Next215
'如果strbmerge不为空.则要合并相应的行和列216
If strbmerge.Trim().Length <> 0 Then217
strm = strbmerge.Split(";")218
For i = 1 To strm.Length - 1219
If strm(i).Split(",").Length = 2 Then220
MergeDouble(totalrow, strm(0), strm(i).Split(",")(1), strm(i).Split(",")(0))221
End If222
MergeSingle(totalrow, strm(0), strm(i))223
Next224
End If225
'删除可能多余的一行226
'GotoRightCell()227
'GotoDownCell()228
'oWordApplic.Selection.Rows.Delete()229
'oTable.AllowAutoFit = True230
'oTable.ApplyStyleFirstColumn = True231
'oTable.ApplyStyleHeadingRows = True232
End Sub233
'插入表格(专门适应工程结算工程量清单)234
Public Sub InsertTableQD(ByRef table As DataTable, ByRef table1 As DataTable)235
Dim oTable As Word.Table236
Dim rowIndex, colIndex, NumRows, NumColumns As Integer237
Dim xmmc As String238
Dim i As Integer239
Dim j As Integer240
rowIndex = 1241
colIndex = 0242
243
If (table.Rows.Count = 0) Then244
Exit Sub245
End If246
247
NumRows = table.Rows.Count + 1248
NumColumns = table.Columns.Count249
'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)250
251
252
'初始化列253
Dim Row As DataRow254
Dim rowtemp As DataRow255
Dim row1() As DataRow256
Dim Col As DataColumn257
Dim coltemp As DataColumn258
'For Each Col In table.Columns259
' colIndex = colIndex + 1260
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)261
'Next262
263
'将行添入表格264
For Each Row In table.Rows265
colIndex = 0266
xmmc = Row("项目名称")267
GotoRightCell()268
oWordApplic.Selection.InsertRows(1)269
For Each Col In table.Columns270
GotoRightCell()271
Try272
If (Col.ColumnName = "项目序号") Then273
oWordApplic.Selection.TypeText(intToUpint(Val(Row(Col.ColumnName))))274
Else275
oWordApplic.Selection.TypeText(Row(Col.ColumnName))276
End If277
Catch ex As Exception278
oWordApplic.Selection.TypeText(" ")279
End Try280
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))281
Next282
row1 = table1.Select("项目名称='" + xmmc + "'")283
284
For i = 0 To row1.Length - 1285
GotoRightCell()286
oWordApplic.Selection.InsertRows(1)287
For j = 0 To table1.Columns.Count - 1288
If (table1.Columns(j).ColumnName <> "项目名称") Then289
GotoRightCell()290
Try291
oWordApplic.Selection.TypeText(row1(i)(j))292
Catch ex As Exception293
oWordApplic.Selection.TypeText(" ")294
End Try295
End If296
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))297
Next298
Next299
300
301
302
Next303
'删除可能多余的一行304
'GotoRightCell()305
'GotoDownCell()306
'oWordApplic.Selection.Rows.Delete()307
'oTable.AllowAutoFit = True308
'oTable.ApplyStyleFirstColumn = True309
'oTable.ApplyStyleHeadingRows = True310
End Sub311
'插入表格,为了满足要求,在中间添加一根竖线312
Public Sub InsertTable3(ByRef table As DataTable, ByVal introw As Integer, ByVal intcol As Integer)313
Dim rowIndex, colIndex, NumRows, NumColumns As Integer314
Dim Row As DataRow315
Dim Col As DataColumn316
If (table.Rows.Count = 0) Then317
Exit Sub318
End If319
'首先是拆分选中的单元格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.Rows325
Try326
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 Exception329
oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(" ")330
oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(" ")331
End Try332
introw = introw + 1333
Next334
End Sub335
'设置对齐336
Public Sub SetAlignment(ByVal strType As String)337
Select Case strType338
Case "center"339
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter340
Case "left"341
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft342
Case "right"343
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight344
Case "justify"345
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify346
End Select347
End Sub348
'设置字体349
Public Sub SetStyle(ByVal strFont As String)350
Select Case strFont351
Case "bold"352
oWordApplic.Selection.Font.Bold = 1353
Case "italic"354
oWordApplic.Selection.Font.Italic = 1355
Case "underlined"356
oWordApplic.Selection.Font.Subscript = 1357
End Select358
End Sub359
'取消字体风格360
Public Sub DissableStyle()361
oWordApplic.Selection.Font.Bold = 0362
oWordApplic.Selection.Font.Italic = 0363
oWordApplic.Selection.Font.Subscript = 0364
End Sub365
'设置字体字号366
Public Sub SetFontSize(ByVal nSize As Integer)367
oWordApplic.Selection.Font.Size = nSize368
End Sub369
'跳过本页370
Public Sub InsertPageBreak()371
Dim pBreak As Integer372
pBreak = CInt(Word.WdBreakType.wdPageBreak)373
oWordApplic.Selection.InsertBreak(pBreak)374
End Sub375
'转到书签376
Public Sub GotoBookMark(ByVal strBookMark As String)377
Dim missing = System.Reflection.Missing.Value378
Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)379
oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)380
End Sub381
'判断书签是否存在382
Public Function BookMarkExist(ByVal strBookMark As String) As Boolean383
Dim Exist As Boolean384
Exist = oDocument.Bookmarks.Exists(strBookMark)385
Return Exist386
End Function387
'替换书签的内容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 Sub393
394
'得到书签的名称395
Public Function GetBookMark(ByVal icurnum As String, ByRef bo As Boolean) As String396
Dim strReturn As String397
If Right(oDocument.Bookmarks(icurnum).Name, 5) = "TABLE" Then398
bo = True399
Dim strTemp As String400
strTemp = oDocument.Bookmarks(icurnum).Name()401
strReturn = Mid(strTemp, 1, Len(strTemp) - 5)402
Else403
bo = False404
strReturn = oDocument.Bookmarks(icurnum).Name405
End If406
Return strReturn407
End Function408
'得到书签的名称409
Public Function GetBookMark1(ByVal icurnum As String) As String410
Return oDocument.Bookmarks(icurnum).Name411
End Function412
'转到文档结尾413
Public Sub GotoTheEnd()414
Dim missing = System.Reflection.Missing.Value415
Dim unit = Word.WdUnits.wdStory416
oWordApplic.Selection.EndKey(unit, missing)417
End Sub418
'转到文档开头419
Public Sub GotoTheBegining()420
Dim missing = System.Reflection.Missing.Value421
Dim unit = Word.WdUnits.wdStory422
oWordApplic.Selection.HomeKey(unit, missing)423
End Sub424
'删除多余的一行425
Public Sub DelUnuseRow()426
oWordApplic.Selection.Rows.Delete()427
End Sub428
'转到表格429
Public Sub GotoTheTable(ByVal ntable As Integer)430
'Dim missing = System.Reflection.Missing.Value431
'Dim what = Word.WdGoToItem.wdGoToTable432
'Dim which = Word.WdGoToDirection.wdGoToFirst433
'Dim count = ntable434
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).Range440
oRange.Select()441
442
End Sub443
'转到表格的某个单元格444
Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)445
oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range446
oRange.Select()447
End Sub448
'表格中转到右面的单元格449
Public Sub GotoRightCell()450
Dim missing = System.Reflection.Missing.Value451
Dim direction = Word.WdUnits.wdCell452
oWordApplic.Selection.MoveRight(direction, missing, missing)453
End Sub454
'表格中转到左面的单元格455
Public Sub GotoLeftCell()456
Dim missing = System.Reflection.Missing.Value457
Dim direction = Word.WdUnits.wdCell458
oWordApplic.Selection.MoveLeft(direction, missing, missing)459
End Sub460
'表格中转到下面的单元格461
Public Sub GotoDownCell()462
Dim missing = System.Reflection.Missing.Value463
Dim direction = Word.WdUnits.wdCell464
oWordApplic.Selection.MoveDown(direction, missing, missing)465
End Sub466
'表格中转到上面的单元格467
Public Sub GotoUpCell()468
Dim missing = System.Reflection.Missing.Value469
Dim direction = Word.WdUnits.wdCell470
oWordApplic.Selection.MoveUp(direction, missing, missing)471
End Sub472
'文档中所有的书签总数473
Public Function TotalBkM() As Integer474
Return oDocument.Bookmarks.Count475
End Function476
'选中书签477
Public Sub SelectBkMk(ByVal strName As String)478
oDocument.Bookmarks.Item(strName).Select()479
End Sub480
'插入图片481
Public Sub InsertPic(ByVal FileName As String)482
Dim missing = System.Reflection.Missing.Value483
oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing).Select()484
oShape = oWordApplic.Selection.InlineShapes(1).ConvertToShape485
oWordApplic.Selection.WholeStory()486
oShape.ZOrder(Microsoft.Office.Core.MsoZOrderCmd.msoSendBehindText)487
End Sub488
'统一调整图片的位置.也就是往上面调整图片一半的高度489
Public Sub SetCurPicHei()490
Dim e As Word.Shape491
For Each e In oDocument.Shapes492
oDocument.Shapes(e.Name).Select()493
oWordApplic.Selection.ShapeRange.RelativeHorizontalPosition = Word.WdRelativeHorizontalPosition.wdRelativeHorizontalPositionPage494
oWordApplic.Selection.ShapeRange.RelativeVerticalPosition = Word.WdRelativeVerticalPosition.wdRelativeVerticalPositionParagraph495
oWordApplic.Selection.ShapeRange.LockAnchor = True496
'oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes(e.Name).Height)497
Next498
End Sub499
500
Public Sub SetCurPicHei1()501
Dim e As Word.Shape502
For Each e In oDocument.Shapes503
oDocument.Shapes(e.Name).Select()504
oWordApplic.Selection.ShapeRange.IncrementTop(oDocument.Shapes(e.Name).Height / 2)505
Next506
End Sub507
Public Sub SetCurPicHei2()508
Dim e As Word.Shape509
For Each e In oDocument.Shapes510
oDocument.Shapes(e.Name).Select()511
oWordApplic.Selection.ShapeRange.IncrementTop(-oDocument.Shapes(e.Name).Height / 2)512
Next513
End Sub514
Public Function intToUpint(ByVal a As Integer) As String515
Dim result As String = "一百"516
Dim a1, a2 As Integer517
Dim strs() As String = 
{"零", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十"}518
If (a <= 10) Then519
result = strs(a)520
ElseIf (a < 100) Then521
a1 = a / 10522
a2 = a Mod 10523
If (a = 1) Then524
result = "十" + strs(a2)525
End If526
Else527
result = strs(a1) + "十" + strs(a2)528
End If529
Return result530
End Function531
'合并没有参照的某一列,一般来讲对应第一列532
'itotalrow 总行数533
'initrow 初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0534
'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 Integer540
Dim direction = Word.WdUnits.wdLine541
Dim extend = Word.WdMovementType.wdExtend542
543
i = 0544
irow = 1 + initrow '初始值为1545
For i = 2 + initrow To itotalrow + initrow546
547
strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text548
If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) Then549
'这是对最后一次处理的特殊情况.550
If (i = itotalrow + initrow) Then551
oWordApplic.Selection.MoveDown(direction, (i - irow), extend)552
If (i - irow >= 1) Then553
oWordApplic.Selection.Cells.Merge()554
End If555
oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue556
End If557
Else558
oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)559
If (i - irow - 1 >= 1) Then560
oWordApplic.Selection.Cells.Merge()561
End If562
oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue563
irow = i564
oDocument.Tables(1).Cell(irow, intcol).Select()565
End If566
Next i567
End Sub568
'合并有参照的某一列569
'itotalrow 总行数570
'initrow 初始开始的行数,一般情况下该值不为0,没有标题栏的一般为0571
'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 Integer578
Dim direction = Word.WdUnits.wdLine579
Dim extend = Word.WdMovementType.wdExtend580
581
i = 0582
irow = 1 + initrow '初始值为1583
For i = 2 + initrow To itotalrow + initrow584
585
strValue = oDocument.Tables(1).Cell(irow, intcol).Range.Text586
If (oDocument.Tables(1).Cell(i, intcol).Range.Text = oDocument.Tables(1).Cell(irow, intcol).Range.Text) And (getdata(i, basecol) = getdata(irow, basecol)) Then587
'这是对最后一次处理的特殊情况.588
If (i = itotalrow + initrow) Then589
oWordApplic.Selection.MoveDown(direction, (i - irow), extend)590
If (i - irow >= 1) Then591
oWordApplic.Selection.Cells.Merge()592
End If593
oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue594
End If595
Else596
oWordApplic.Selection.MoveDown(direction, (i - irow - 1), extend)597
If (i - irow - 1 >= 1) Then598
oWordApplic.Selection.Cells.Merge()599
End If600
oDocument.Tables(1).Cell(irow, intcol).Range.Text = strValue601
irow = i602
oDocument.Tables(1).Cell(irow, intcol).Select()603
End If604
Next i605
End Sub606
'得到某个单元的值,如果为空的话,有两种情况.607
'其一：是一个合并的单元格，取其上面的值608
'其二：该单元格本来就是空值609
Public Function getdata(ByVal introw As Integer, ByVal intcol As Integer) As String610
Try611
If (oDocument.Tables(1).Cell(introw, intcol).Range.Text = "" Or (oDocument.Tables(1).Cell(introw, intcol).Range.Text = Nothing)) Then612
getdata = getdata(introw - 1, intcol)613
Else614
getdata = oDocument.Tables(1).Cell(introw, intcol).Range.Text615
End If616
Catch ex As Exception617
getdata = getdata(introw - 1, intcol)618
End Try619
620
621
End Function622
End Class623
624
