VB.NET操作WORD

发布时间：2020-12-17 00:26:50 所属栏目：大数据来源：网络整理

导读：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 91011 Publi

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 91011 Public Sub New()12 '激活com word接口13 oWordApplic = New Word.ApplicationClass14 oWordApplic.Visible = False1516 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 Else3132 End If33 End Sub3435 '生成空的新文档36 Public Sub NewDocument()37 Dim missing = System.Reflection.Missing.Value38 Dim isVisible As Boolean = True39 oDocument = oWordApplic.Documents.Add(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,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.Value5758 strName = FileName59 isReadOnly = False60 isVisible = True6162 oDocument = oWordApplic.Documents.Open(strName,isReadOnly,isVisible,missing)63 oDocument.Activate()6465 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.Value7071 strName = FileName72 isVisible = True7374 oDocument = oWordApplic.Documents.Open(strName,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()9091 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.Value105106 strName = FileName107108 oDocument.SaveAs(strName,missing)109 End Sub110 '保存为Html文件111 Public Sub SaveAsHtml(ByVal FileName As String)112 Dim missing = System.Reflection.Missing.Value113 Dim strName As String114115 strName = FileName116 Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)117118 oDocument.SaveAs(strName,format,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 If144145 NumRows = table.Rows.Count + 1146 NumColumns = table.Columns.Count147 oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(),NumColumns)148149150 '初始化列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 'Next157158 '将行添入表格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 = True171172 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,NumColumns As Integer177 Dim strm() As String178 Dim i As Integer179 rowIndex = 1180 colIndex = 0181182 If (table.Rows.Count = 0) Then183 Exit Sub184 End If185186 NumRows = table.Rows.Count + 1187 NumColumns = table.Columns.Count188 'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(),NumColumns)189190191 '初始化列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 'Next198199 '将行添入表格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),")(0))221 End If222 MergeSingle(totalrow,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,NumColumns As Integer237 Dim xmmc As String238 Dim i As Integer239 Dim j As Integer240 rowIndex = 1241 colIndex = 0242243 If (table.Rows.Count = 0) Then244 Exit Sub245 End If246247 NumRows = table.Rows.Count + 1248 NumColumns = table.Columns.Count249 'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(),NumColumns)250251252 '初始化列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 'Next262263 '将行添入表格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 + "'")283284 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 Next299300301302 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,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,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 Sub393394 '得到书签的名称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 = ntable434435 'oWordApplic.Selection.GoTo(what,which,count,missing)436 'oWordApplic.Selection.ClearFormatting()437438 'oWordApplic.Selection.Text = ""439 oRange = oDocument.Tables(ntable).Cell(1,1).Range440 oRange.Select()441442 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)453 End Sub454 '表格中转到左面的单元格455 Public Sub GotoLeftCell()456 Dim missing = System.Reflection.Missing.Value457 Dim direction = Word.WdUnits.wdCell458 oWordApplic.Selection.MoveLeft(direction,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)465 End Sub466 '表格中转到上面的单元格467 Public Sub GotoUpCell()468 Dim missing = System.Reflection.Missing.Value469 Dim direction = Word.WdUnits.wdCell470 oWordApplic.Selection.MoveUp(direction,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 Sub499500 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.wdExtend542543 i = 0544 irow = 1 + initrow '初始值为1545 For i = 2 + initrow To itotalrow + initrow546547 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 初始开始的行数,没有标题栏的一般为0571 'intcol 列数572 'basecol 参照合并的那一列573 Public Sub MergeDouble(ByVal itotalrow 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.wdExtend580581 i = 0582 irow = 1 + initrow '初始值为1583 For i = 2 + initrow To itotalrow + initrow584585 strValue = oDocument.Tables(1).Cell(irow,intcol).Range.Text586 If (oDocument.Tables(1).Cell(i,intcol).Range.Text) And (getdata(i,basecol) = getdata(irow,basecol)) Then587 '这是对最后一次处理的特殊情况.588 If (i = itotalrow + initrow) Then589 oWordApplic.Selection.MoveDown(direction,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,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 Try619620621 End Function622End Class623624

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!