|
在这里给出了一个Word操作的类，该类具备了对word 文档操作的基本功能，包括word 文档的新建，打开，保存，另存，插入图片，插入表格，插入文字，读取文字，定位光标位置，移动光标，移动到指定页等等操作。在下一篇文章中我将给出这个类实现的实例，读者可以借鉴下程序引用的是Microsoft Word 14.0 Object Library 使用word 2007 +VS2010
1 '*********************************************************************
2 '作者：章鱼哥，QQ：3107073263 群：309816713
3 '如有疑问或好的建议请联系我，大家一起进步
4 '*********************************************************************
5 Imports Microsoft.Office.Interop
6 Public Class Class_Word1
7
8 Public ZWordApplic As Word.Application
9
10 Private ZDocument As Word.Document
11
12 Public Sub New() '生成类实例
13 ZWordApplic = New Word.Application
14 ZWordApplic.Visible = True
15
16 End Sub
17
18 '新建一个Word文档
19 Public Sub NewDocument()
20
21 ZDocument = ZWordApplic.Documents.Add() '新建一个文档
22
23 End Sub
24 '使用模板新建一个文档
25 Public Sub ModulNewDocument(ByVal FileAddress As String)
26 ZDocument = ZWordApplic.Documents.Add(FileAddress)
27
28 End Sub
29 '打开一个文档
30 Public Sub OpenWordDocument(ByVal FileAddress As String, ByVal IsReadOnly As Boolean)
31 Try
32 ZDocument = ZWordApplic.Documents.Open(FileAddress, Nothing, IsReadOnly)
33 Catch ex As Exception
34 MsgBox("您输入的地址不正确")
35 End Try
36 End Sub
37
38 '关闭一个文档
39 Public Sub CloseWordDocument()
40 ZWordApplic.Quit()
41 System.Runtime.InteropServices.Marshal.ReleaseComObject(ZWordApplic)
42 ZWordApplic = Nothing
43 End Sub
44 '关闭所有打开的文档
45 Public Sub CloseAllDocuments()
46
47 ' ZWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
48 ZWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
49 End Sub
50 '保存文档
51 Public Sub Save()
52 Try
53 ZDocument.Save()
54 MsgBox("保存成功")
55 Catch ex As Exception
56 MsgBox(ex.Message)
57 End Try
58 End Sub
59 '另存为
60 Public Sub SaveAs(ByVal FileAdress As String)
61 Try
62 ZDocument.SaveAs2(FileAdress)
63 MsgBox("另存为成功！")
64 Catch ex As Exception
65 MsgBox(ex.Message)
66 End Try
67 End Sub
68 '插入文字
69 Public Sub InsertText(ByVal text As String)
70
71 ZWordApplic.Selection.TypeText(text)
72
73 End Sub
74
75 '插入表格
76 Public Sub InsertTabel(ByVal Tabel As DataTable)
77 Dim ZTabel As Word.Table
78 ZTabel = ZDocument.Tables.Add(ZWordApplic.Selection.Range, Tabel.Rows.Count + 1, Tabel.Columns.Count)
79
80
81 '添加表头
82 For i = 1 To Tabel.Columns.Count
83 ZTabel.Rows(1).Cells(i).Range.InsertAfter(Tabel.Columns(i - 1).ColumnName)
84 Next
85 '添加表格数据
86 For i = 2 To Tabel.Rows.Count + 1
87 For j = 1 To Tabel.Columns.Count
88 ZTabel.Rows(i).Cells(j).Range.InsertAfter(Tabel.Rows(i - 2).Item(j - 1).ToString)
89 Next
90 Next
91
92
93 ZTabel.AllowAutoFit = True
94
95 ZTabel.ApplyStyleFirstColumn = True
96
97 ZTabel.ApplyStyleHeadingRows = True
98 End Sub
99 '插入图片
100 Public Sub InsertPic(ByVal PicAddress As String)
101
102 Try
103 ZWordApplic.Selection.InlineShapes.AddPicture(PicAddress, False, True)
104
105 Catch ex As Exception
106 MsgBox("图片地址不正确 ")
107 End Try
108
109
110 End Sub
111 '读取文字
112 Public Sub ReadText()
113 ZWordApplic.Selection.WholeStory()
114 ZWordApplic.Selection.Copy()
115
116 End Sub
117 '获取当前的光标位置信息，存放在数组中
118 Public Function GetCursor() As ArrayList
119 Try
120 Dim cursor As New ArrayList
121 '当前光标所在的页数
122 Dim Page As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdActiveEndAdjustedPageNumber)
123 '当前光标所在行数
124 Dim row As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdFirstCharacterLineNumber)
125 '当前光标所在列数
126 Dim cul As Object = ZDocument.Application.Selection.Information(Word.WdInformation.wdFirstCharacterColumnNumber)
127 cursor.AddRange({Page, row, cul})
128 Return cursor
129 Catch ex As Exception
130 MsgBox(ex.Message)
131 Return Nothing
132 End Try
133 End Function
134
135
136 '鼠标定位到指定页
137 Public Sub GoToPage(ByVal Page As Integer)
138 Try
139 '跳转到指定页码
140 ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToPage, Word.WdGoToDirection.wdGoToFirst, Page)
141
142
143 Catch ex As Exception
144 MsgBox(ex.Message)
145 End Try
146 End Sub
147 '光标调到指定行。这个是绝对跳转
148 Public Sub GoToAbsolutLine(ByVal Row As Integer)
149 Try
150 '跳转到指定行，说明：这个行是相对于整个文档来算的，将如第一页就2行，你跳到第三行的时候，就是第2页的第1行
151 '读者可自行测试，目前还实现不了给定页，行，列调到精确位置的功能。至少我还没实现。这里就不进行实现了
152 ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToFirst, Row)
153
154
155 Catch ex As Exception
156 MsgBox(ex.Message)
157 End Try
158 End Sub
159 '光标调到指定行。这个是相对跳转。大家应该理解什么意思的
160 Public Sub GoToOppsiteLine(ByVal Row As Int16)
161 Try
162
163
164 '读者可自行测试，目前还实现不了给定页，行，列调到精确位置的功能。至少我还没实现
165 If Row >= 0 Then '如果大于0，像后跳转
166 ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToNext, Math.Abs(Row))
167 Else '小于0，像前跳转
168 ZDocument.Application.Selection.GoTo(Word.WdGoToItem.wdGoToLine, Word.WdGoToDirection.wdGoToPrevious, Math.Abs(Row))
169 End If
170
171
172
173
174 Catch ex As Exception
175 MsgBox(ex.Message)
176 End Try
177 End Sub
178 '左移光标
179 Public Sub MoveLeft()
180 ZDocument.Application.Selection.MoveLeft() '每次移动1位
181 End Sub
182 '右移
183 Public Sub MoveRight()
184 ZDocument.Application.Selection.MoveRight() '每次移动1位
185 End Sub
186 '上移
187 Public Sub MoveUp()
188 ZDocument.Application.Selection.MoveUp() '每次移动1位
189 End Sub
190 '下移
191 Public Sub MoveDown()
192 ZDocument.Application.Selection.MoveDown() '每次移动1位
193 End Sub
194 End class
实现窗体：
1 '作者：章鱼哥，QQ：3107073263 群：309816713
2 '如有疑问或好的建议请联系我，大家一起进步
3 '*********************************************************************
4 Imports Microsoft.Office.Interop
5 Public Class Form1
6 Dim Array_Word As New ArrayList
7
8 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
9 RichTextBox1.Text = "章鱼哥出品VB.NET"
10 End Sub
11 '新建一个Word文档
12 Private Sub But_NewWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_NewWord.Click
13 Dim My_word As New Class_Word1
14 My_word.NewDocument()
15 Array_Word.Add(My_word)
16 End Sub
17 '以模板新建
18 Private Sub But_ModuleNewWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_ModuleNewWord.Click
19 Dim My_word As New Class_Word1
20 My_word.ModulNewDocument(TextBox1.Text)
21 Array_Word.Add(My_word)
22 End Sub
23 '打开一个文档
24 Private Sub But_OpenWord_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_OpenWord.Click
25 Dim My_word As New Class_Word1
26 My_word.OpenWordDocument(TextBox1.Text, False)
27 Array_Word.Add(My_word)
28 End Sub
29
30
31 '关闭当前打开的所有文档
32 Private Sub But_CloseAllDocument_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_CloseAllDocument.Click
33 For Each Word_Class As Class_Word1 In Array_Word
34 Word_Class.CloseWordDocument()
35 Next
36 Array_Word.Clear()
37 End Sub
38
39 '保存文档
40 Private Sub But_Save_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_Save.Click
41 For Each Word_Class As Class_Word1 In Array_Word
42 Word_Class.Save()
43 Next
44 End Sub
45 '另存为
46 Private Sub But_SaveAs_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_SaveAs.Click
47
48 For Each Word_Class As Class_Word1 In Array_Word
49 Word_Class.SaveAs(TextBox1.Text)
50 Next
51
52 End Sub
53 '插入文本
54 Private Sub But_Insert_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_Insert.Click
55 For Each Word_Class As Class_Word1 In Array_Word
56 Word_Class.InsertText(RichTextBox1.Text)
57 Next
58 End Sub
59 '插入表格
60 Private Sub But_InsertTabel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_InsertTabel.Click
61 Dim tabel As DataTable = GetTabel(ListView1)
62
63 For Each Word_Class As Class_Word1 In Array_Word
64 Word_Class.InsertTabel(GetTabel(ListView1))
65 Next
66 End Sub
67 '从listview 中读取数据生成DataTable
68 Private Function GetTabel(ByVal lis As ListView) As DataTable
69 Dim Tabel As New DataTable()
70 '加表头
71 For i = 0 To lis.Columns.Count - 1
72 Tabel.Columns.Add(lis.Columns(i).Text.ToString)
73 Next
74
75 For i = 0 To lis.Items.Count - 1
76 Dim row As DataRow = Tabel.NewRow
77 For j = 0 To lis.Columns.Count - 1
78
79 row.Item(j) = lis.Items(i).SubItems(j).Text
80
81
82 Next
83 Tabel.Rows.Add(row)
84 Next
85 Return Tabel
86 End Function
87 '插入图片
88 Private Sub But_InsertPic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_InsertPic.Click
89 For Each Word_Class As Class_Word1 In Array_Word
90 Word_Class.InsertPic(TextBox2.Text)
91 Next
92 End Sub
93 '读取文档的内容
94 Private Sub But_ReadText_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_ReadText.Click
95 For Each Word_Class As Class_Word1 In Array_Word
96 Word_Class.ReadText()
97 RichTextBox1.Paste()
98 Next
99 End Sub
100 '*********************************************************************
101 '获取文档路径
102 Private Sub But_GetAdrress_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GetAdrress.Click
103 Dim opendialog As New OpenFileDialog
104 If opendialog.ShowDialog = DialogResult.OK Then
105 TextBox1.Text = opendialog.FileName
106 End If
107 End Sub
108 '获取当前鼠标的位置
109 Private Sub But_GetCursor_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GetCursor.Click
110 For Each Word_Class As Class_Word1 In Array_Word
111 Dim Cursor As ArrayList = Word_Class.GetCursor()
112 If Cursor IsNot Nothing Then
113 For i = 0 To Cursor.Count - 1
114 RichTextBox1.Text &= " " & Cursor(i)
115 Next
116 End If
117 Next
118 End Sub
119
120 '将光标移动到指定页
121 Private Sub But_GoTo_Page_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GoTo_Page.Click
122 For Each Word_Class As Class_Word1 In Array_Word
123 Word_Class.GoToPage(Tex_Page.Text)
124 Next
125 End Sub
126 '光标移动到指定行(绝对)
127 Private Sub But_GotoAbsoultRow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GotoAbsoultRow.Click
128 For Each Word_Class As Class_Word1 In Array_Word
129 Word_Class.GoToAbsolutLine(Tex_Row_Absoult.Text)
130 Next
131 End Sub
132 '光标移动到指定行(相对)
133 Private Sub But_GotoOppsitRow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles But_GotoOppsitRow.Click
134 For Each Word_Class As Class_Word1 In Array_Word
135 Word_Class.GoToOppsiteLine(Tex_Row_Oppsit.Text)
136 Next
137 End Sub
138
139 '上下左右按钮，点击按钮一次移动一位
140 Private Sub PictureBox1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
141 'MsgBox("X:" & e.X & "Y:" & e.Y)
142 Dim x As Integer = e.X
143 Dim y As Integer = e.Y
144 'RichTextBox1.Text &= "|" & e.X & ":" & e.Y
145 For Each Word_Class As Class_Word1 In Array_Word
146 If x > 70 And x < 130 Then
147 If y > 20 And y < 45 Then
148 Word_Class.MoveUp()
149 ElseIf y > 110 And y < 135 Then
150 Word_Class.MoveDown()
151 End If
152
153 End If
154 If y > 45 And y < 105 Then
155 If x > 40 And x < 65 Then
156 Word_Class.MoveLeft()
157 ElseIf x > 135 And y < 160 Then
158 Word_Class.MoveRight()
159 End If
160 End If
161 Next
162 End Sub
163 End Class
|