您现在的位置： 365建站网 > 365文章 > VB.NET Office操作之读取新建Word文档的方法

VB.NET Office操作之读取新建Word文档的方法

文章来源：365jz.com     点击数：637    更新时间：2017-11-09 15:33   参与评论
在这里给出了一个Word操作的类，该类具备了对word 文档操作的基本功能，包括word 文档的新建，打开，保存，另存，插入图片，插入表格，插入文字，读取文字，定位光标位置，移动光标，移动到指定页等等操作。在下一篇文章中我将给出这个类实现的实例，读者可以借鉴下
程序引用的是Microsoft Word 14.0 Object Library 使用word 2007 +VS2010
Imports Microsoft.Office.Interop
Public Class Class_Word1
 
    Public ZWordApplic As Word.Application
 
    Private ZDocument As Word.Document
 
    Public Sub New() '生成类实例
        ZWordApplic = New Word.Application
        ZWordApplic.Visible = True
 
    End Sub
 
    '新建一个Word文档
    Public Sub NewDocument()
      
        ZDocument = ZWordApplic.Documents.Add() '新建一个文档
 
    End Sub
    '使用模板新建一个文档
    Public Sub ModulNewDocument(ByVal FileAddress As String)
        ZDocument = ZWordApplic.Documents.Add(FileAddress)
 
    End Sub
    '打开一个文档
    Public Sub OpenWordDocument(ByVal FileAddress As String, ByVal IsReadOnly As Boolean)
        Try
            ZDocument = ZWordApplic.Documents.Open(FileAddress, Nothing, IsReadOnly)
        Catch ex As Exception
            MsgBox("您输入的地址不正确")
        End Try
    End Sub
 
    '关闭一个文档
    Public Sub CloseWordDocument()
        ZWordApplic.Quit()
        System.Runtime.InteropServices.Marshal.ReleaseComObject(ZWordApplic)
        ZWordApplic = Nothing
    End Sub
    '关闭所有打开的文档
    Public Sub CloseAllDocuments()
 
        ' ZWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
        ZWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
    End Sub
    '保存文档
    Public Sub Save()
        Try
            ZDocument.Save()
            MsgBox("保存成功")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    '另存为
    Public Sub SaveAs(ByVal FileAdress As String)
        Try
            ZDocument.SaveAs2(FileAdress)
            MsgBox("另存为成功！")
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    '插入文字
    Public Sub InsertText(ByVal text As String)
 
        ZWordApplic.Selection.TypeText(text)
 
    End Sub
 
    '插入表格
    Public Sub InsertTabel(ByVal Tabel As DataTable)
        Dim ZTabel As Word.Table
        ZTabel = ZDocument.Tables.Add(ZWordApplic.Selection.Range, Tabel.Rows.Count + 1, Tabel.Columns.Count)
 
      
        '添加表头
        For i = 1 To Tabel.Columns.Count
            ZTabel.Rows(1).Cells(i).Range.InsertAfter(Tabel.Columns(i - 1).ColumnName)
        Next
        '添加表格数据
        For i = 2 To Tabel.Rows.Count + 1
            For j = 1 To Tabel.Columns.Count
                ZTabel.Rows(i).Cells(j).Range.InsertAfter(Tabel.Rows(i - 2).Item(j - 1).ToString)
            Next
        Next
       
 
        ZTabel.AllowAutoFit = True
 
        ZTabel.ApplyStyleFirstColumn = True
 
        ZTabel.ApplyStyleHeadingRows = True
    End Sub
    '插入图片 
    Public Sub InsertPic(ByVal PicAddress As String)
 
        Try
            ZWordApplic.Selection.InlineShapes.AddPicture(PicAddress, False, True)
 
        Catch ex As Exception
            MsgBox("图片地址不正确 ")
        End Try
 
 
    End Sub
    '读取文字
    Public Sub ReadText()
        ZWordApplic.Selection.WholeStory()
        ZWordApplic.Selection.Copy()
 
    End Sub
 '获取当前的光标位置信息，存放在数组中
    Public Function GetCursor() As ArrayList
        Try
            Dim cursor As New ArrayList
            '当前光标所在的页数
            Dim Page As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdActiveEndAdjustedPageNumber)
            '当前光标所在行数
            Dim row As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdFirstCharacterLineNumber)
            '当前光标所在列数
            Dim cul As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdFirstCharacterColumnNumber)
            cursor.AddRange({Page, row, cul})
            Return cursor
        Catch ex As Exception
            MsgBox(ex.Message)
            Return Nothing
        End Try
    End Function
 
 
    '鼠标定位到指定页
    Public Sub GoToPage(ByVal Page As Integer)
        Try
            '跳转到指定页码
            ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToPage, Word.WdGoToDirection.wdGoToFirst, Page)
 
 
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    '光标调到指定行。这个是绝对跳转
    Public Sub GoToAbsolutLine(ByVal Row As Integer)
        Try
            '跳转到指定行，说明：这个行是相对于整个文档来算的，将如第一页就2行，你跳到第三行的时候，就是第2页的第1行
            '读者可自行测试，目前还实现不了给定页，行，列调到精确位置的功能。至少我还没实现。这里就不进行实现了
            ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToFirst, Row)
 
 
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    '光标调到指定行。这个是相对跳转。大家应该理解什么意思的
    Public Sub GoToOppsiteLine(ByVal Row As Int16)
        Try
 
 
            '读者可自行测试，目前还实现不了给定页，行，列调到精确位置的功能。至少我还没实现
            If Row >= 0 Then '如果大于0，像后跳转
                ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToNext, Math.Abs(Row))
            Else '小于0，像前跳转
                ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToPrevious, Math.Abs(Row))
            End If
 
 
 
 
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try
    End Sub
    '左移光标
    Public Sub MoveLeft()
        ZDocument.Application.Selection.MoveLeft() '每次移动1位
    End Sub
    '右移
    Public Sub MoveRight()
        ZDocument.Application.Selection.MoveRight() '每次移动1位
    End Sub
    '上移
    Public Sub MoveUp()
        ZDocument.Application.Selection.MoveUp() '每次移动1位
    End Sub
    '下移
    Public Sub MoveDown()
        ZDocument.Application.Selection.MoveDown() '每次移动1位
    End Sub

本文是在上文给出的Class_Word1类的实例，实现了类中的各个功能，读者可借鉴参考。

实现窗体：

 




代码实现：代码直接复制到上文的窗体类中

'*********************************************************************
 

Imports Microsoft.Office.Interop
Public Class Form1
    Dim Array_Word As New ArrayList
 
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        RichTextBox1.Text = "章鱼哥出品VB.NET"
    End Sub
    '新建一个Word文档
    Private Sub But_NewWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_NewWord.Click
        Dim My_word As New Class_Word1
        My_word.NewDocument()
        Array_Word.Add(My_word)
    End Sub
    '以模板新建 
    Private Sub But_ModuleNewWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_ModuleNewWord.Click
        Dim My_word As New Class_Word1
        My_word.ModulNewDocument(TextBox1.Text)
        Array_Word.Add(My_word)
    End Sub
    '打开一个文档
    Private Sub But_OpenWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_OpenWord.Click
        Dim My_word As New Class_Word1
        My_word.OpenWordDocument(TextBox1.Text, False)
        Array_Word.Add(My_word)
    End Sub
   
  
    '关闭当前打开的所有文档
    Private Sub But_CloseAllDocument_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_CloseAllDocument.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.CloseWordDocument()
        Next
        Array_Word.Clear()
    End Sub
 
    '保存文档
    Private Sub But_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_Save.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.Save()
        Next
    End Sub
    '另存为 
    Private Sub But_SaveAs_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_SaveAs.Click
     
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.SaveAs(TextBox1.Text)
        Next
 
    End Sub
    '插入文本
    Private Sub But_Insert_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_Insert.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.InsertText(RichTextBox1.Text)
        Next
    End Sub
    '插入表格
    Private Sub But_InsertTabel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_InsertTabel.Click
        Dim tabel As DataTable = GetTabel(ListView1)
 
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.InsertTabel(GetTabel(ListView1))
        Next
    End Sub
    '从listview 中读取数据生成DataTable
    Private Function GetTabel(ByVal lis As ListView) As DataTable
        Dim Tabel As New DataTable()
        '加表头
        For i = 0 To lis.Columns.Count - 1
            Tabel.Columns.Add(lis.Columns(i).Text.ToString)
        Next
 
        For i = 0 To lis.Items.Count - 1
            Dim row As DataRow = Tabel.NewRow
            For j = 0 To lis.Columns.Count - 1
 
                row.Item(j) = lis.Items(i).SubItems(j).Text
 
 
            Next
            Tabel.Rows.Add(row)
        Next
        Return Tabel
    End Function
    '插入图片
    Private Sub But_InsertPic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_InsertPic.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.InsertPic(TextBox2.Text)
        Next
    End Sub
    '读取文档的内容
    Private Sub But_ReadText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_ReadText.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.ReadText()
            RichTextBox1.Paste()
        Next
    End Sub
 
 '获取文档路径
    Private Sub But_GetAdrress_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GetAdrress.Click
        Dim opendialog As New OpenFileDialog
        If opendialog.ShowDialog = DialogResult.OK Then
            TextBox1.Text = opendialog.FileName
        End If
    End Sub
    '获取当前鼠标的位置 
    Private Sub But_GetCursor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GetCursor.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Dim Cursor As ArrayList = Word_Class.GetCursor()
            If Cursor IsNot Nothing Then
                For i = 0 To Cursor.Count - 1
                    RichTextBox1.Text &= "  " & Cursor(i)
                Next
            End If
        Next
    End Sub
 
    '将光标移动到指定页
    Private Sub But_GoTo_Page_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GoTo_Page.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.GoToPage(Tex_Page.Text)
        Next
    End Sub
    '光标移动到指定行(绝对)
    Private Sub But_GotoAbsoultRow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GotoAbsoultRow.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.GoToAbsolutLine(Tex_Row_Absoult.Text)
        Next
    End Sub
    '光标移动到指定行(相对)
    Private Sub But_GotoOppsitRow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GotoOppsitRow.Click
        For Each Word_Class As Class_Word1 In Array_Word
            Word_Class.GoToOppsiteLine(Tex_Row_Oppsit.Text)
        Next
    End Sub
 
    '上下左右按钮，点击按钮一次移动一位
    Private Sub PictureBox1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        'MsgBox("X:" & e.X & "Y:" & e.Y)
        Dim x As Integer = e.X
        Dim y As Integer = e.Y
        'RichTextBox1.Text &= "|" & e.X & ":" & e.Y
        For Each Word_Class As Class_Word1 In Array_Word
            If x > 70 And x < 130 Then
                If y > 20 And y < 45 Then
                    Word_Class.MoveUp()
                ElseIf y > 110 And y < 135 Then
                    Word_Class.MoveDown()
                End If
 
            End If
            If y > 45 And y < 105 Then
                If x > 40 And x < 65 Then
                    Word_Class.MoveLeft()
                ElseIf x > 135 And y < 160 Then
                    Word_Class.MoveRight()
                End If
            End If
        Next
    End Sub

 

End Class

如对本文有疑问，请提交到交流论坛，广大热心网友会为你解答！！ 点击进入论坛

您可能感兴趣的文章:

发表评论 (637人查看，0条评论)
请自觉遵守互联网相关的政策法规，严禁发布色情、暴力、反动的言论。
昵称：
最新评论
------分隔线----------------------------
大家感兴趣的内容
最近更新的内容

公司信息

· 网站介绍
· 联系我们
· 加入我们
· 服务条款

快速入口

· 365软件
· 杰创官网
· 建站工具
· 网站大全

其它栏目

· 建站教程
· 365学习

业务咨询

· 技术支持
· 服务时间：9:00-18:00
365建站网二维码

Powered by 365建站网 RSS地图 HTML地图

copyright © 2013-2024 版权所有 鄂ICP备17013400号