VB控制Word文档实例精选二

        1、返回Word文档的段落文字，控制分页，设置页眉和页脚

[vb]  view plain copy

1. '先引用Microsoft Word 11.0 Object Library  
2. Option Explicit  
3.   
4. Dim WordApp As Word.Application '创建Word应用程序  
5.   
6. Private Sub Command1_Click()  
7.     Dim i As Long  
8.     On Error GoTo Errhandler  
9.     CommonDialog1.Filter = "Word(*.Doc)|*.Doc|AllFile(*.*)|*.*"  
10.     CommonDialog1.FilterIndex = 1  
11.     CommonDialog1.ShowOpen  
12.     Set WordApp = New Word.Application '实例化  
13.     WordApp.Documents.Open CommonDialog1.FileName '打开Word文件  
14.     WordApp.Visible = True '显示 Office Word 界面  
15.     '或者Application.Visible = True  
16.     WordApp.DisplayAlerts = False '不提示保存对话框  
17.       
18.     '返回段落文字，返回的段落文字在文本框控件中  
19.     Text1.Text = ""  
20.     For i = 1 To ActiveDocument.Paragraphs.Count  
21.         Text1.Text = Text1.Text & (ActiveDocument.Paragraphs(i).Range.Text & vbCrLf & vbCrLf)  
22.     Next  
23.       
24.     '控制分页  
25.     WordApp.Selection.EndKey unit:=wdStory  '将光标移到文档末尾  
26.     WordApp.Selection.InsertBreak wdPageBreak '在文档末尾插入一页  
27.       
28.     '设置图片格式的页眉  
29.     If ActiveWindow.View.SplitSpecial <> wdPaneNone Then  
30.        ActiveWindow.Panes(2).Close  
31.     End If  
32.     If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Then  
33.        ActiveWindow.ActivePane.View.Type = wdPrintView  
34.     End If  
35.     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader  
36.     Selection.InlineShapes.AddPicture FileName:="F:\资料\My Pictures\2013年元旦.gif", LinkToFile:=False, SaveWithDocument:=True '加载一图片文件作为页眉  
37.     Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft  
38.     ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument  
39.       
40.     '设置文本格式的页眉  
41.     If ActiveWindow.View.SplitSpecial <> wdPaneNone Then  
42.        ActiveWindow.Panes(2).Close  
43.     End If  
44.     If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Then  
45.        ActiveWindow.ActivePane.View.Type = wdPrintView  
46.     End If  
47.     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader  
48.     Selection.TypeText Text:="办公室常用工具"  
49.     ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument  
50.       
51.     '隐藏页眉的横线  
52.     WordApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Borders(wdBorderBottom).Visible = False  
53.       
54.     '取得页眉的内容  
55.     Debug.Print WordApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text  '获取WORD第一节的页眉的文字内容  
56.       
57.       
58.     '设置页脚  
59.     If ActiveWindow.View.SplitSpecial <> wdPaneNone Then  
60.        ActiveWindow.Panes(2).Close  
61.     End If  
62.     If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Then  
63.        ActiveWindow.ActivePane.View.Type = wdPrintView  
64.     End If  
65.     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader  
66.     If Selection.HeaderFooter.IsHeader = True Then  
67.        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter  
68.     Else  
69.        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader  
70.     End If  
71.     Selection.TypeText Text:="2013年" '设置页脚  
72.     Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldNumPages  
73.     ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument  
74.       
75.     ActiveDocument.SaveAs "c:\MyWord.doc" '保存最后生成的word文档  
76.           
77. Errhandler:  
78.     Exit Sub  
79. End Sub  
80.   
81. Private Sub Form_Unload(Cancel As Integer)  
82.     On Error Resume Next  
83.     WordApp.Quit  
84.     Set WordApp = Nothing  
85. End Sub  

        效果图如下：

 

        2、控制Word文档中的文本框对象

[vb]  view plain copy

1. '先引用Microsoft Word 11.0 Object Library  
2. Option Explicit  
3.   
4. Dim WordApp As Word.Application '创建Word应用程序  
5.   
6. Private Sub Command1_Click()  
7.     On Error GoTo Errhandler  
8.     CommonDialog1.Filter = "MS Office Word(*.Doc)|*.Doc|AllFile(*.*)|*.*"  
9.     CommonDialog1.FilterIndex = 1  
10.     CommonDialog1.ShowOpen  
11.     Set WordApp = New Word.Application '实例化  
12.     WordApp.Documents.Open CommonDialog1.FileName '打开Word文件  
13.     If Documents.Count >= 1 Then  
14.        Text1.Text = "打开的Word文件是：" & ActiveDocument.Name & vbCrLf & vbCrLf  
15.     End If  
16.     WordApp.Visible = True '显示 Office Word 界面  
17.     '或者Application.Visible = True  
18.     WordApp.DisplayAlerts = False '不提示保存对话框  
19.       
20.     WordApp.Selection.EndKey unit:=wdStory  '将光标移到文档末尾  
21.     WordApp.Selection.Font.Bold = 1  
22.     WordApp.Selection.Font.Name = "黑体"  
23.     WordApp.Selection.Font.Size = 18  
24.     WordApp.Selection.TypeText Text:="在Word文件中插入文本框对象"  
25.     WordApp.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter '居中显示  
26.           
27.     '创建文本框对象,座标（100，100），宽度200，高度200  
28.     With ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 400, 300).Fill  
29.          '.Transparency = 1 '设置透明色  
30.          .ForeColor = vbRed '设置前景颜色  
31.          .UserPicture ("F:\资料\My Pictures\758254_960x1000_0.jpg") '设置文本框对象的背景图片  
32.     End With  
33.     ActiveDocument.Shapes(1).TextFrame.TextRange.Text = "这是一个美女" '给文本框赋值  
34.     'ActiveDocument.Shapes(1).Line.Transparency = 1 '设置透明边框线条  
35.       
36.     '再创建一个透明背景的文本框对象  
37.     With ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 400, 400, 300).Fill  
38.          .Transparency = 1 '设置透明色背景  
39.          .ForeColor = vbRed '设置前景颜色  
40.     End With  
41.     ActiveDocument.Shapes(2).TextFrame.TextRange.Text = "这是一个透明背景的文本框" '给文本框赋值  
42.     'ActiveDocument.Shapes(2).Line.Transparency = 1 '设置透明边框线条  
43.       
44.     '下面是获取文本框对象的内容  
45.     Dim i As Long      
46.     For i = 1 To ActiveDocument.Shapes.Count  
47.         Text1.Text = Text1.Text & ("第" & i & "个文本框的内容：" & ActiveDocument.Shapes(i).TextFrame.TextRange.Text & vbCrLf)  
48.     Next  
49.       
50.     ActiveDocument.SaveAs "c:\MyWord.doc" '保存最后生成的word文档  
51.       
52. Errhandler:  
53.     Exit Sub  
54. End Sub  
55.   
56. Private Sub Form_Unload(Cancel As Integer)  
57.     On Error Resume Next  
58.     WordApp.Quit  
59.     Set WordApp = Nothing  
60. End Sub  

        效果图如下：

 

        3、在Word文档中设置Excel风格的页码

[vb]  view plain copy

1. '先引用Microsoft Word 11.0 Object Library  
2. Option Explicit  
3.   
4. Dim WordApp As Word.Application '创建Word应用程序  
5. Dim WordDoc As Word.Document    '创建Word文档对象  
6.   
7. Private Sub Command1_Click()  
8.     Dim i As Long  
9.     On Error GoTo Errhandler  
10.     CommonDialog1.Filter = "Word(*.Doc)|*.Doc|AllFile(*.*)|*.*"  
11.     CommonDialog1.FilterIndex = 1  
12.     CommonDialog1.ShowOpen  
13.     Set WordApp = New Word.Application '实例化  
14.     Set WordDoc = WordApp.Documents.Open(CommonDialog1.FileName) '选择并打开Word文件  
15.     WordApp.Visible = True '显示 Office Word 界面  
16.     '或者Application.Visible = True  
17.     WordApp.DisplayAlerts = False '不提示保存对话框  
18.       
19.     '设置Word文档第一页页码  
20.     Dim WordRange As Range  
21.     Set WordRange = WordApp.ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range  
22.            
23.     With WordRange  
24.          .InsertAfter "第"  
25.          .Font.Size = 14  
26.          .Collapse Direction:=wdCollapseEnd  
27.       
28.          '插入页码域  
29.          .Fields.Add Range:=WordRange, Type:=wdFieldEmpty, Text:="PAGE  \* Arabic ", PreserveFormatting:=True  
30.          .Expand unit:=wdWord  
31.          .InsertAfter "页 "  
32.       
33.          .InsertAfter "共"  
34.          .Collapse Direction:=wdCollapseEnd  
35.        
36.          '插入页数域  
37.          .Fields.Add Range:=WordRange, Type:=wdFieldEmpty, Text:="NUMPAGES  \* Arabic ", PreserveFormatting:=True  
38.          .Expand unit:=wdWord  
39.          .InsertAfter "页"  
40.   
41.          .InsertAfter "【我的Word文件 作者：ChenJL1031（东方之珠）】"  
42.          .ParagraphFormat.Alignment = wdAlignParagraphRight '右对齐  
43.     End With  
44.       
45.     'Text1.Text = WordApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range.Text  
46.       
47.     Set WordRange = Nothing  
48.     ActiveDocument.SaveAs "c:\MyWord.doc" '保存最后生成的word文档  
49.           
50. Errhandler:  
51.     Exit Sub  
52. End Sub  
53.   
54. Private Sub Form_Unload(Cancel As Integer)  
55.     On Error Resume Next  
56.     WordApp.Quit  
57.     Set WordApp = Nothing  
58. End Sub  

        效果图如下：