PublicClass vbwordappClass vbwordapp Private oWordApplic As word.ApplicationClass Private oDoc As word.Document PublicSub vbwordapp()Sub vbwordapp() '激活com word接口 oWordApplic =New Word.ApplicationClass End Sub ' Open a file (the file must exists) and activate it PublicSub open()Sub open(ByVal strFilename AsString) Dim filename AsString Dim onlyread AsBoolean Dim isvisible AsBoolean Dim missing filename = strFilename onlyread =False isvisible =True missing = System.Reflection.Missing.Value oDoc = oWordApplic.Documents.Open(filename, missing, onlyread, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing) oDoc.Activate() End Sub '打开一个文档 PublicSub open()Sub open() Dim missing missing = System.Reflection.Missing.Value oDoc = oWordApplic.Documents.Add(missing, missing, missing, missing) oDoc.Activate() End Sub PublicSub quit()Sub quit() Dim missing missing = System.Reflection.Missing.Value oWordApplic.Quit() System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic) oWordApplic =Nothing End Sub PublicSub releaseword()Sub releaseword(ByVal strfilename AsString) Dim filename AsString Dim onlyread AsBoolean Dim isvisible AsBoolean Dim missing filename = strfilename onlyread =False isvisible =True missing = System.Reflection.Missing.Value oWordApplic.Documents.Close() End Sub PublicSub save()Sub save() oDoc.Save() End Sub PublicSub saveas()Sub saveas(ByVal strfilename AsString) Dim missing Dim filename AsString missing = System.Reflection.Missing.Value filename = strfilename oDoc.SaveAs(filename, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing) End Sub PublicSub saveashtml()Sub saveashtml(ByVal strfilename AsString) Dim missing missing = System.Reflection.Missing.Value Dim filename AsString filename = strfilename Dimformat format=CInt(Word.WdSaveFormat.wdFormatHTML) oDoc.SaveAs(filename, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing) End Sub PublicSub inserttext()Sub inserttext(ByVal strtext) oWordApplic.Selection.TypeText(strtext) End Sub PublicSub insertlinebreak()Sub insertlinebreak() oWordApplic.Selection.TypeParagraph() End Sub PublicSub insertlinebreak()Sub insertlinebreak(ByVal nline AsInteger) Dim i For i =1To nline oWordApplic.Selection.TypeParagraph() Next End Sub PublicSub inserttable()Sub inserttable(ByVal table As DataTable) Dim oTable As Word.Table Dim rowIndex, colIndex AsInteger rowIndex =1 colIndex =0 oTable = oWordApplic.Selection.Tables.Add(oWordApplic.Selection.Range(), NumRows:=table.Rows.Count +1, NumColumns:=table.Columns.Count) '将所得到的表的列名,赋值给单元格 Dim Col As DataColumn Dim Row As DataRow ForEach Col In table.Columns colIndex = colIndex +1 oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName) Next '得到的表所有行,赋值给单元格 ForEach Row In table.Rows rowIndex = rowIndex +1 colIndex =0 ForEach Col In table.Columns colIndex = colIndex +1 oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName)) Next Next oTable.AllowAutoFit =True oTable.ApplyStyleFirstColumn =True oTable.ApplyStyleHeadingRows =True End Sub PublicSub setalignment()Sub setalignment(ByVal strtype AsString) SelectCase strtype Case"center" oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter Case"left" oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft Case"right" oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight Case"justify" oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify EndSelect End Sub PublicSub setfont()Sub setfont(ByVal strtype AsString) SelectCase strtype Case"bold" oWordApplic.Selection.Font.Bold =1 Case"italic" oWordApplic.Selection.Font.Italic =1 Case"underlined" oWordApplic.Selection.Font.Subscript =0 EndSelect End Sub ' disable all the style PublicSub SetFont()Sub SetFont() oWordApplic.Selection.Font.Bold =0 oWordApplic.Selection.Font.Italic =0 oWordApplic.Selection.Font.Subscript =0 End Sub PublicSub SetFontName()Sub SetFontName(ByVal strType AsString) oWordApplic.Selection.Font.Name = strType End Sub PublicSub SetFontSize()Sub SetFontSize(ByVal nSize AsInteger) oWordApplic.Selection.Font.Size = nSize End Sub PublicSub insertpagebreak()Sub insertpagebreak() Dim pBreak AsInteger pBreak =CInt(Word.WdBreakType.wdPageBreak) oWordApplic.Selection.InsertBreak(pBreak) End Sub ' Go to a predefined bookmark, if the bookmark doesn't exists the application will raise an error PublicSub GotoBookMark()Sub GotoBookMark(ByVal strBookMarkName AsString) Dim missing missing = System.Reflection.Missing.Value Dim Bookmark Bookmark =CInt(Word.WdGoToItem.wdGoToBookmark) Dim namebookmark namebookmark = strBookMarkName oWordApplic.Selection.GoTo(Bookmark, missing, missing, namebookmark) End Sub PublicFunction BookmarkExist()Function BookmarkExist(ByVal strBookMarkName AsString) AsBoolean Dim exist AsBoolean exist = oDoc.Bookmarks.Exists(strBookMarkName) Return exist End Function PublicSub GoToTheEnd()Sub GoToTheEnd() Dim missing, unit missing = System.Reflection.Missing.Value unit = Word.WdUnits.wdStory oWordApplic.Selection.EndKey(unit, missing) End Sub PublicSub GoToTheBeginning()Sub GoToTheBeginning() Dim missing, unit missing = System.Reflection.Missing.Value unit = Word.WdUnits.wdStory oWordApplic.Selection.HomeKey(unit, missing) End Sub PublicSub GoToTheTable()Sub GoToTheTable(ByVal ntable AsInteger) Dim missing, what, which, count missing = System.Reflection.Missing.Value what = Word.WdUnits.wdTable which = Word.WdGoToDirection.wdGoToAbsolute count =1 oWordApplic.Selection.GoTo(what, which, 1, missing) oWordApplic.Selection.Find.ClearFormatting() oWordApplic.Selection.Text ="" End Sub PublicSub GoToRightCell()Sub GoToRightCell() Dim missing, direction missing = System.Reflection.Missing.Value direction = Word.WdUnits.wdCell oWordApplic.Selection.MoveRight(direction, missing, missing) End Sub PublicSub GoToLeftCell()Sub GoToLeftCell() Dim missing, direction missing = System.Reflection.Missing.Value direction = Word.WdUnits.wdCell oWordApplic.Selection.MoveLeft(direction, missing, missing) End Sub PublicSub GoToDownCell()Sub GoToDownCell() Dim missing, direction missing = System.Reflection.Missing.Value direction = Word.WdUnits.wdLine oWordApplic.Selection.MoveDown(direction, missing, missing) End Sub PublicSub GoToUpCell()Sub GoToUpCell() Dim missing, direction missing = System.Reflection.Missing.Value direction = Word.WdUnits.wdLine oWordApplic.Selection.MoveUp(direction, missing, missing) End Sub ' this function doesn't work PublicSub InsertPageNumber()Sub InsertPageNumber(ByVal strType AsString, ByVal bHeader AsBoolean) Dim missing, alignment, bfirstpage, bf missing = System.Reflection.Missing.Value bfirstpage =False bf =True SelectCase strType Case"Center" alignment = Word.WdPageNumberAlignment.wdAlignPageNumberCenter oWordApplic.Selection.HeaderFooter.PageNumbers.Item(1).Alignment = Word.WdPageNumberAlignment.wdAlignPageNumberCenter Case"Right" alignment = Word.WdPageNumberAlignment.wdAlignPageNumberRight oWordApplic.Selection.HeaderFooter.PageNumbers.Item(1).Alignment = Word.WdPageNumberAlignment.wdAlignPageNumberRight Case"Left" alignment = Word.WdPageNumberAlignment.wdAlignPageNumberLeft oWordApplic.Selection.HeaderFooter.PageNumbers.Add(alignment, bfirstpage) EndSelect End Sub PublicSub insertpic()Sub insertpic(ByVal filename AsString) Dim missing missing = System.Reflection.Missing.Value oWordApplic.Selection.InlineShapes.AddPicture(filename, False, True, missing) End Sub End Class