在.net里面实现对word操作的vba宏的类,用vb.net编写

Public Class vbwordapp

Private oWordApplic As word.ApplicationClass

Private oDoc As word.Document

Public Sub vbwordapp()

'激活com word接口

oWordApplic = New Word.ApplicationClass

End Sub

' Open a file (the file must exists) and activate it

Public Sub open(ByVal strFilename As String)

Dim filename As String

Dim onlyread As Boolean

Dim isvisible As Boolean

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

'打开一个文档

Public Sub open()

Dim missing

missing = System.Reflection.Missing.Value

oDoc = oWordApplic.Documents.Add(missing, missing, missing, missing)

oDoc.Activate()

End Sub

Public Sub quit()

Dim missing

missing = System.Reflection.Missing.Value

oWordApplic.Quit()

System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)

oWordApplic = Nothing

End Sub

Public Sub releaseword(ByVal strfilename As String)

Dim filename As String

Dim onlyread As Boolean

Dim isvisible As Boolean

Dim missing

filename = strfilename

onlyread = False

isvisible = True

missing = System.Reflection.Missing.Value

oWordApplic.Documents.Close()

End Sub

Public Sub save()

oDoc.Save()

End Sub

Public Sub saveas(ByVal strfilename As String)

Dim missing

Dim filename As String

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

Public Sub saveashtml(ByVal strfilename As String)

Dim missing

missing = System.Reflection.Missing.Value

Dim filename As String

filename = strfilename

Dim format

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

Public Sub inserttext(ByVal strtext)

oWordApplic.Selection.TypeText(strtext)

End Sub

Public Sub insertlinebreak()

oWordApplic.Selection.TypeParagraph()

End Sub

Public Sub insertlinebreak(ByVal nline As Integer)

Dim i

For i = 1 To nline

oWordApplic.Selection.TypeParagraph()

Next

End Sub

Public Sub inserttable(ByVal table As DataTable)

Dim oTable As Word.Table

Dim rowIndex, colIndex As Integer

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

For Each Col In table.Columns

colIndex = colIndex + 1

oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)

Next

'得到的表所有行,赋值给单元格

For Each Row In table.Rows

rowIndex = rowIndex + 1

colIndex = 0

For Each 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

Public Sub setalignment(ByVal strtype As String)

Select Case 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

End Select

End Sub

Public Sub setfont(ByVal strtype As String)

Select Case strtype

Case "bold"

oWordApplic.Selection.Font.Bold = 1

Case "italic"

oWordApplic.Selection.Font.Italic = 1

Case "underlined"

oWordApplic.Selection.Font.Subscript = 0

End Select

End Sub

' disable all the style

Public Sub SetFont()

oWordApplic.Selection.Font.Bold = 0

oWordApplic.Selection.Font.Italic = 0

oWordApplic.Selection.Font.Subscript = 0

End Sub

Public Sub SetFontName(ByVal strType As String)

oWordApplic.Selection.Font.Name = strType

End Sub

Public Sub SetFontSize(ByVal nSize As Integer)

oWordApplic.Selection.Font.Size = nSize

End Sub

Public Sub insertpagebreak()

Dim pBreak As Integer

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

Public Sub GotoBookMark(ByVal strBookMarkName As String)

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

Public Function BookmarkExist(ByVal strBookMarkName As String) As Boolean

Dim exist As Boolean

exist = oDoc.Bookmarks.Exists(strBookMarkName)

Return exist

End Function

Public Sub GoToTheEnd()

Dim missing, unit

missing = System.Reflection.Missing.Value

unit = Word.WdUnits.wdStory

oWordApplic.Selection.EndKey(unit, missing)

End Sub

Public Sub GoToTheBeginning()

Dim missing, unit

missing = System.Reflection.Missing.Value

unit = Word.WdUnits.wdStory

oWordApplic.Selection.HomeKey(unit, missing)

End Sub

Public Sub GoToTheTable(ByVal ntable As Integer)

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

Public Sub GoToRightCell()

Dim missing, direction

missing = System.Reflection.Missing.Value

direction = Word.WdUnits.wdCell

oWordApplic.Selection.MoveRight(direction, missing, missing)

End Sub

Public Sub GoToLeftCell()

Dim missing, direction

missing = System.Reflection.Missing.Value

direction = Word.WdUnits.wdCell

oWordApplic.Selection.MoveLeft(direction, missing, missing)

End Sub

Public Sub GoToDownCell()

Dim missing, direction

missing = System.Reflection.Missing.Value

direction = Word.WdUnits.wdLine

oWordApplic.Selection.MoveDown(direction, missing, missing)

End Sub

Public 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

Public Sub InsertPageNumber(ByVal strType As String, ByVal bHeader As Boolean)

Dim missing, alignment, bfirstpage, bf

missing = System.Reflection.Missing.Value

bfirstpage = False

bf = True

Select Case 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)

End Select

End Sub

Public Sub insertpic(ByVal filename As String)

Dim missing

missing = System.Reflection.Missing.Value

oWordApplic.Selection.InlineShapes.AddPicture(filename, False, True, missing)

End Sub

End Class