原文出处 http://www.fenglog.com/blog/article.asp?id=341

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