'注意需要安裝微軟的WORD才可以正常使用
welText='本腳本運行後將在WORD種顯示一些電腦的資訊'
MsgBox welText
'定義Word.application變數
Dim ObjWD
Dim ObjDOC
Dim counti
Set WshNetwork=CreateObject('WScript.Network')
'啟動Word
Set ObjWD=CreateObject('Word.application')
'設置Word為可視
ObjWD.Visible=True
'增加一個文檔
ObjWD.Documents.Add
Set ObjDOC=ObjWD.ActiveDocuments
'設置格式為劇中對齊
ObjWD.selection.ParagraphFormat.Alignment=wdAlignParagraphCenter
ObjDOC.Range 0,0
ObjWD.selection.TypeText '電腦資訊一覽表'+Chr(13)
'增加一張四行二列的表格
ObjDOC.Tables.Add ObjWD.selection.Range,4,2
ObjWD.selection.TypeText '類別'
ObjWD.selection.Moveright
ObjWD.selection.TypeText '值'
'迴圈填寫表格內容
For counti=1 To 3
ObjWD.selection.MoveDown
ObjWD.selection.MoveLeft
Select Case counti
Case 1
ObjWD.selection.TypeText '功能變數名稱'
ObjWD.selection.MoveRight
ObjWD.selection.TypeText WshNetwork.UserDomain
Case 2
ObjWD.selection.TypeText '電腦名'
ObjWD.selection.MoveRight
ObjWD.selection.TypeText WshNetwork.ComputerName
Case 3
ObjWD.selection.TypeText '用戶名'
ObjWD.selection.MoveRight
ObjWD.selection.TypeText WshNetwork.UserName
End Select
Next
'將WORD視窗最大化
ObjWD.WindowState=1
'選中全部文檔
ObjWD.selection.WholeStory
'設置字體
ObjWD.selection.font.Name='宋體'
'設置字型大小
ObjWD.selection.font.Size=14
'設置對齊方式為居中
ObjWD.selection.ParagraphFormat.Alignment=1
'取消全部選中
ObjWD.selection.MoveDown
我们先来说，这两个对象Application对象、Document对象。application对象他是一个word的应用事例。也就是说原先存在一个word文件的话，你可以用这个对象。
Set myDocs = CreateObject('Word.Application')
如果要创建或打开一个word文件的话，就必须要用到document对象。
Set myDoc = myDocs.Documents
Set myDoc1 = myDoc.Open('c:\My Documents\biao1.doc')
用Activate方法可以激活一个文档，激活之后，可以来访问文档中的对象。
用add方法可以添加想要的东西。
下面我们再来说一下Range对象。Range对象实际上就是一个文字区域。我们可以用他在激活的文档中添加一空行。
myDoc1.ActiveDocument.Paragraphs.Add.Range.InsertBefore('')
也可以在引号之内放上我们想要的文字。
写好文字之后，可以来设他的属性。
Set myPara = myDoc1.ActiveDocument.Paragraphs(1).Range
With myPara
.Bold = ture
.ParagraphFormat.Alignment = 1 '文字居中
.Font.Name = 'Arial'
.Font.Size = 12
End With
Add Formatted Text to a Word Document
Demonstration script that displays formatted data in a Microsoft Word document.
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Font.Name = 'Arial'
objSelection.Font.Size = '18'
objSelection.TypeText 'Network Adapter Report'
objSelection.TypeParagraph()
objSelection.Font.Size = '14'
objSelection.TypeText '' & Date()
objSelection.TypeParagraph()
Add a Formatted Table to a Word Document
Demonstration script that retrieves service data from a computer and then displays that data in a formatted table in Microsoft Word.
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objRange = objDoc.Range()
objDoc.Tables.Add objRange,1,3
Set objTable = objDoc.Tables(1)
x=1
strComputer = '.'
Set objWMIService = _
GetObject('winmgmts:\\' & strComputer & '\root\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_Service')
For Each objItem in colItems
If x > 1 Then
objTable.Rows.Add()
End If
objTable.Cell(x, 1).Range.Font.Bold = True
objTable.Cell(x, 1).Range.Text = objItem.Name
objTable.Cell(x, 2).Range.text = objItem.DisplayName
objTable.Cell(x, 3).Range.text = objItem.State
x = x + 1
Apply a Style to a Table in a Word Document
Demonstration script that retrieves service data from a computer, displays that data in a table in Microsoft Word, then formats the data by using a predefined Microsoft Word style
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objRange = objDoc.Range()
objDoc.Tables.Add objRange,1,3
Set objTable = objDoc.Tables(1)
objTable.Range.Font.Size = 10
objTable.Range.Style = 'Table Contemporary'
x=2
objTable.Cell(x, 1).Range.Text = 'Service Name'
objTable.Cell(x, 2).Range.text = 'Display Name'
objTable.Cell(x, 3).Range.text = 'State'
strComputer = '.'
Set objWMIService = _
GetObject('winmgmts:\\' & strComputer & '\root\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_Service')
For Each objItem in colItems
If x > 1 Then
objTable.Rows.Add()
End If
objTable.Cell(x, 1).Range.Text = objItem.Name
objTable.Cell(x, 2).Range.text = objItem.DisplayName
objTable.Cell(x, 3).Range.text = objItem.State
x = x + 1
Next
Add a Table to a Word Document
Demonstration script that retrieves service information from a computer and then displays that information in tabular format in Microsoft Word.
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objRange = objDoc.Range()
objDoc.Tables.Add objRange,1,3
Set objTable = objDoc.Tables(1)
x=1
strComputer = '.'
Set objWMIService = _
GetObject('winmgmts:\\' & strComputer & '\root\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_Service')
For Each objItem in colItems
If x > 1 Then
objTable.Rows.Add()
End If
objTable.Cell(x, 1).Range.Text = objItem.Name
objTable.Cell(x, 2).Range.text = objItem.DisplayName
objTable.Cell(x, 3).Range.text = objItem.State
x = x + 1
Next
Append Text to a Word Document
Demonstration script that appends the current date to the existing Microsoft Word document C:\Scripts\Word\Testdoc.doc.
Const END_OF_STORY = 6
Const MOVE_SELECTION = 0
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Open('c:\scripts\word\testdoc.doc')
Set objSelection = objWord.Selection
objSelection.EndKey END_OF_STORY, MOVE_SELECTION
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = '14'
objSelection.TypeText '' & Date()
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = '10'
Demonstration script that creates and displays a new Microsoft Word document.
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Create and Save a Word Document
Demonstration script that retrieves network adapter data from a computer, displays that data in a Microsoft Word document, and then saves the document as C:\Scripts\Word\Testdoc.doc.
Set objWord = CreateObject('Word.Application')
objWord.Caption = 'Test Caption'
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.Font.Name = 'Arial'
objSelection.Font.Size = '18'
objSelection.TypeText 'Network Adapter Report'
objSelection.TypeParagraph()
objSelection.Font.Size = '14'
objSelection.TypeText '' & Date()
objSelection.TypeParagraph()
objSelection.TypeParagraph()
objSelection.Font.Size = '10'
strComputer = '.'
Set objWMIService = GetObject('winmgmts:\\' & strComputer & '\root\cimv2')
Set colItems = objWMIService.ExecQuery _
('Select * from Win32_NetworkAdapterConfiguration')
For Each objItem in colItems
objSelection.Font.Bold = True
objSelection.TypeText 'ARP Always Source Route: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.ArpAlwaysSourceRoute
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'ARP Use EtherSNAP: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.ArpUseEtherSNAP
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Caption: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.Caption
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Database Path: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.DatabasePath
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Dead GW Detection Enabled: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.DeadGWDetectEnabled
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Default IP Gateway: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.DefaultIPGateway
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Default TOS: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.DefaultTOS
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Default TTL: '
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.DefaultTTL
objSelection.TypeParagraph()
objSelection.Font.Bold = True
objSelection.TypeText 'Description: '
objSelection.Font.Bold = True
objSelection.Font.Bold = False
objSelection.TypeText '' & objItem.Description
objSelection.TypeParagraph()
objSelection.TypeParagraph()
Next
objDoc.SaveAs('C:\Scripts\Word\testdoc.doc')
objWord.Quit
Display Service Information in a Word Document
Demonstration script that retrieves service information from a computer and then displays that data in a Microsoft Word document.
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
objSelection.TypeText 'Services Report'
objSelection.TypeParagraph()
objSelection.TypeText '' & Now
objSelection.TypeParagraph()
objSelection.TypeParagraph()
strComputer = '.'
Set objWMIService = _
GetObject('winmgmts:\\' & strComputer & '\root\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_Service')
For Each objItem in colItems
objSelection.TypeText objItem.DisplayName & ' -- ' & objItem.State
objSelection.TypeParagraph()
Next
List Microsoft Word Properties
Demonstration script that lists Microsoft Word configuration settings.
On Error Resume Next
Set objWord = CreateObject('Word.Application')
Wscript.Echo 'Active Printer:', objWord.ActivePrinter
For Each objAddIn in objWord.AddIns
Wscript.Echo 'AddIn: ', objAddIn
Next
Wscript.Echo 'Application:', objWord.Application
Wscript.Echo 'Assistant:', objWord.Assistant
For Each objCaption in objWord.AutoCaptions
Wscript.Echo 'AutoCaptions:', objCaption
Next
Wscript.Echo 'Automation Security:', objWord.AutomationSecurity
Wscript.Echo 'Background Printing Status:', objWord.BackgroundPrintingStatus
Wscript.Echo 'Background Saving Status:', objWord.BackgroundSavingStatus
Wscript.Echo 'Browse Extra File Type:', objWord.BrowseExtraFileTypes
Wscript.Echo 'Build:', objWord.Build
Wscript.Echo 'Caps Lock:', objWord.CapsLock
Wscript.Echo 'Caption:', objWord.Caption
For Each objLabel in objWord.CaptionLabels
Wscript.Echo 'Caption Label:', objLabel
Next
Wscript.Echo 'Check Language:', objWord.CheckLanguage
For Each objAddIn in objWord.COMAddIns
Wscript.Echo 'COM AddIn:', objAddIn
Next
Wscript.Echo 'Creator:', objWord.Creator
For Each objDictionary in objWord.CustomDictionaries
Wscript.Echo 'Custom Dictionary:', objDictionary
Next
Wscript.Echo 'Customization Context:', objWord.CustomizationContext
Wscript.Echo 'Default Legal Blackline:', objWord.DefaultLegalBlackline
Wscript.Echo 'Default Save Format:', objWord.DefaultSaveFormat
Wscript.Echo 'Default Table Separator:', objWord.DefaultTableSeparator
For Each objDialog in objWord.Dialogs
Wscript.Echo 'Dialog:', objDialog
Next
Wscript.Echo 'Display Alerts:', objWord.DisplayAlerts
Wscript.Echo 'Display Recent Files:', objWord.DisplayRecentFiles
Wscript.Echo 'Display Screen Tips:', objWord.DisplayScreenTips
Wscript.Echo 'Display Scroll Bars:', objWord.DisplayScrollBars
For Each objDocument in objWord.Documents
Wscript.Echo 'Document:', objDocument
Next
Wscript.Echo 'Email Template:', objWord.EmailTemplate
Wscript.Echo 'Enable Cancel Key:', objWord.EnableCancelKey
Wscript.Echo 'Feature Install:', objWord.FeatureInstall
For Each objConverter in objWord.FileConverters
Wscript.Echo 'File Converter:', objConverter
Next
Wscript.Echo 'Focus In MailHeader:', objWord.FocusInMailHeader
For Each objFont in objWord.FontNames
Wscript.Echo 'Font Name:', objFont
Next
Wscript.Echo 'Height', objWord.Height
For Each objBinding in objWord.KeyBindings
Wscript.Echo 'Key Binding:', objBinding
Next
For Each objFont in objWord.LandscapeFontNames
Wscript.Echo 'Landscape Font Name:', objFont
Next
Wscript.Echo 'Language', objWord.Language
For Each objLanguage in objWord.Languages
Wscript.Echo 'Language:', objLanguage
Next
Wscript.Echo 'Left', objWord.Left
Wscript.Echo 'Mail System:', objWord.MailSystem
Wscript.Echo 'MAPI Available:', objWord.MAPIAvailable
Wscript.Echo 'Math Coprocessor Available:', objWord.MathCoprocessorAvailable
Wscript.Echo 'Mouse Available:', objWord.MouseAvailable
Wscript.Echo 'Name:', objWord.Name
Wscript.Echo 'Normal Template:', objWord.NormalTemplate
Wscript.Echo 'Num Lock:', objWord.NumLock
Wscript.Echo 'Parent:', objWord.Parent
Wscript.Echo 'Path:', objWord.Path
Wscript.Echo 'Path Separator:', objWord.PathSeparator
Wscript.Echo 'Print Preview:', objWord.PrintPreview
For Each objFile in objWord.RecentFiles
Wscript.Echo 'Recent File:', objFile
Next
Wscript.Echo 'Screen Updating:', objWord.ScreenUpdating
Wscript.Echo 'Show Visual Basic Editor:', objWord.ShowVisualBasicEditor
Wscript.Echo 'Special Mode:', objWord.SpecialMode
Wscript.Echo 'Startup Path:', objWord.StartupPath
For Each objTask in objWord.Tasks
Wscript.Echo 'Task:', objTask
Next
For Each objTemplate in objWord.Templates
Wscript.Echo 'Template:', objTemplate
Next
Wscript.Echo 'Top:', objWord.Top
Wscript.Echo 'Usable Height:', objWord.UsableHeight
Wscript.Echo 'Usable Width:', objWord.UsableWidth
Wscript.Echo 'User Address:', objWord.UserAddress
Wscript.Echo 'User Control:', objWord.UserControl
Wscript.Echo 'User Initials:', objWord.UserInitials
Wscript.Echo 'User Name:', objWord.UserName
Wscript.Echo 'Version:', objWord.Version
Wscript.Echo 'Visible:', objWord.Visible
Wscript.Echo 'Width:', objWord.Width
For Each objWindow in objWord.Windows
Wscript.Echo 'Window:', objWindow
Next
Wscript.Echo 'Window State:', objWord.WindowState
objWord.Quit
Modify Bookmark Text in a Word Document
Demonstration script that changes the text of two different bookmarks in an existing Microsoft Word document.
Set objWord = CreateObject('Word.Application')
objWord.Caption = 'Test Caption'
objWord.Visible = True
Set objDoc = objWord.Documents.Open('c:\scripts\word\bookmarkdoc.doc')
Set objRange = objDoc.Bookmarks('NameBookmark').Range
objRange.Text = 'Bob'
Set objRange = objDoc.Bookmarks('AddressBookmark').Range
objRange.Text = '999'
Open and Print a Word Document
Demonstration script that opens and prints and existing Microsoft Word document.
Set objWord = CreateObject('Word.Application')
Set objDoc = objWord.Documents.Open('c:\scripts\inventory.doc')
objDoc.PrintOut()
objWord.Quit
Read a Bookmark in a Word Document
Demonstration script that retrieves the values of two different Microsoft Word bookmarks.
Set objWord = CreateObject('Word.Application')
Set objDoc = objWord.Documents.Open('c:\scripts\word\bookmarkdoc.doc')
Set objRange = objDoc.Bookmarks('NameBookmark').Range
Wscript.Echo objRange.Text
Set objRange = objDoc.Bookmarks('AddressBookmark').Range
Wscript.Echo objRange.Text
objWord.Quit
Demonstration script that uses Microsoft Word to locate all the .mp3 files stored on drive C of the local computer.
Set objWord = CreateObject('Word.Application')
Set objDoc = objWord.Documents.Add()
objWord.FileSearch.FileName = '*.mp3'
objWord.FileSearch.LookIn = 'C:\'
objWord.FileSearch.SearchSubfolders = True
objWord.FileSearch.Execute
For Each objFile in objWord.FileSearch.FoundFiles
Wscript.Echo objFile
Next
objWord.Quit
列出WORD命令：
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.ListCommands(True)
Set objDoc = objWord.Documents(1)
Set objTable = objDoc.Tables(1)
For i = 1 to objTable.Rows.Count
strText = objTable.Cell(i,2).Range.Text
strText = strText & objTable.Cell(i,3).Range.Text
intLength = Len(strText)
If intLength <= 4="">
objTable.Rows(i).Delete
i = i - 1
End If
Next
菜单和工具栏在编程中都是同一个对象——CommandBars，所有对菜单和工具栏的编程都必然是围绕这个对象展开的，右键菜单也不例外，并且每个右键菜单对应一个CommandBar对象，例如:在Word中，CommandBars(“Text”)相当于在文档中单击右键弹出的菜单， CommandBars(“Text”).ShowPopup可以弹出右键菜单，相当于单击了右键。
菜单和工具栏的每一个选项分别对应一个Control，例如：CommandBars(“Text”).Controls(1)对应右键菜单的第一项， CommandBars(“Text”).Controls(1).Enabled = False可使”剪切”选项失效。
可用Name属性引用CommandBar对象，Caption属性引用Control;序号则可用于两者.CommandBars(63).Name的值就是”Text”， CommandBars(63).Controls('剪切(&T)').Enabled = False同样可令右键菜单的”剪切”选项失效。
菜单项中的某一项如果有子菜单，那么这项也属于CommandBar对象，如“视图”菜单中的“工具栏”有有关工具栏的子菜单，所以“视图”属于CommandBar对象，想禁用“视图”，可用语句：CommandBars('View').Controls(5).CommandBar.Enabled = False，很多网友问怎样禁止在工具栏上弹出右键菜单，用这行代码就可以实现。
如文件菜单下的打印
CommandBars('menu Bar').Controls('文件(&F)').Controls('打印(&P)...').Enabled = 0
看到这里，你可能会问:那我怎样才知道什么序号和Caption对应什么菜单项和Control呢？粘贴下列代码运行，就会一目了然。
Sub 列举菜单项()
For i = 1 To CommandBars.Count
Selection.TypeText i & ':' & CommandBars(i).Name
Selection.TypeParagraph
For a = 1 To CommandBars(i).Controls.Count
Selection.TypeText ' ' & a & ':' & CommandBars(i).Controls(a).Caption
Selection.TypeParagraph
Next
Next
End Sub
不仅在Word中，在Excel、access、Powerpoint、Fontpage、Outlook同样包含CommandBars对象，因此上述内容同样适用于这些Office组件，同样可以用Word来列举它们的菜单。下列代码用于在Word中列举其它组件的菜单。
注意要在“工具”菜单中的“引用”项中引用“Microsoft Word 9.0 Object Library”
Sub 列举菜单项()
Set wdapp = New Word.Application
Set wdapp = CreateObject('Word.Application')
wdapp.Visible = True
Set wdDoc = wdapp.Documents.Add
For i = 1 To CommandBars.Count
wdapp.Selection.TypeText i & ':' & CommandBars(i).Name
wdapp.Selection.TypeParagraph
For a = 1 To CommandBars(i).Controls.Count
wdapp.Selection.TypeText ' ' & a & ':' & CommandBars(i).Controls(a).Caption
wdapp.Selection.TypeParagraph
Next
Next
End Sub
另附一段调整工具栏位置的程序
Sub 工具栏位置()
CommandBars('clipboard').Visible = True
CommandBars('clipboard').Position = msoBarTop
CommandBars('clipboard').RowIndex = CommandBars('standard').RowIndex
CommandBars('clipboard').Left = CommandBars('standard').Left + CommandBars('standard').Width
End Sub
1.CommandBars集合
Office软件中，每个软件所有的工具栏均可用该集合来代表，该集合可通过名称或索引号来指定菜单栏或工具栏，如前面“宏”代码的“CommandBars('Formatting')”语句，即通过名称“Formatting”指定了“格式工具栏”。Add方法用于新建工具栏，并返回CommandBar对象。
2.CommandBar对象
该对象代表工具栏，新建工具栏的控件均以该对象为载体，是VBA工具栏开发的核心对象，其常用方法和属性如下：
Position属性：用于设置工具栏的位置，可通过VBA常量将工具栏的位置设置为置顶、居左、居右、置下或浮动。
Visible属性：用于设置工具栏是否可见。
Enabled属性：用于设置工具栏是否可用。
Reset方法：将内置工具栏的设置重置为默认设置，删除其中的自定义控件，在恢复软件原有工具栏或菜单时非常有用。
3.CommandBarPopup 对象
该对象代表工具栏中的一个弹出式控件，其实Office软件的菜单也可理解为一个弹出式的控件，而菜单栏可以视为“另类”的工具栏。因此，通过该对象即可添加菜单栏，方法和添加工具栏类似。
4.CommandBarButton对象
该对象代表工具栏的按钮控件，是常用的工具栏二次开发控件，其常用方法和属性如下：
OnAction属性：用于设置VBA代码过程名（该代码过程不可使用参数），该过程在单击按钮后运行。本文实例程序即通过该属性使单击相关控件后可执行指定的操作。
Style属性：用于设置工具栏按钮的显示方式，可通过VBA常量进行设置。
FaceId属性：用于设置工具栏按钮的图标编号，即设置工具栏按钮的外观。自定义图标的工具栏按钮，其FaceId属性值需设置为0。
BeginGroup属性：用于设置控件是否分组显示。
5.CommandBarComboBox对象
该对象代表工具栏中的组合框、下拉框或文本框控件，也是常用的工具栏二次开发控件。
代码随模板加载而自动执行
为使模板中的VBA代码可在某些特定操作中（如加载或打开时）自动执行，必须通过VBA提供的自动宏来实现。
自动宏是一些特殊的宏，这些宏可在执行特定操作时运行（类似DOS时代在系统启动时执行的“AutoExec.bat”文件）。以Word XP为例，其提供的自动宏如下所述：
AutoExec宏：启动Word XP或加载全局模板触发。
AutoNew宏：生成新文档时触发。
AutoOpen宏：打开已有文档时触发。
AutoClose宏：关闭文档时触发。
AutoExit宏：退出Word XP或卸载全局模板时触发。
小提示
前述的自动宏，除“AutoExec”宏必须保存在“Startup”文件夹的 Normal 模板或共用模板中才可自动运行外，其他均可保存于Normal 模板、其他模板或文档中。
在文档打开时按Shift键可终止自动宏的运行。
新建工具栏和自定义菜单
录制“宏”之后，在VBA的工程资源管理器中将自动添加一个名称为“NewMacros”的模块，双击该模块的图标，即可显示代码编辑窗口，如图3所示。
1.定义一些全局变量
Dim Obj_Toolbar As CommandBar'代表工具栏的变量
Dim Obj_Menu As CommandBarPopup'代表菜单的变量
Dim Obj_Toolbar_button As CommandBarButton'代表菜单项和按钮的变量
2.编制生成工具栏和菜单的子程序
Sub addbutton()'创建工具栏和菜单并设置属性的子程序
deletebutton'调用删除工具栏和菜单的子程序
Set Obj_Toolbar = Application.CommandBars.Add('My_Custom_Bar')'新建工具栏，“My_Custom_Bar”代表工具栏的名称
Set Obj_Menu = Obj_Toolbar.Controls.Add(Type:=msoControlPopup, ID:=1)'在工具栏上新建下拉菜单，“ID:=1”代表该工具栏的功能由用户自定义，下同
With Obj_Menu'设置下拉菜单的属性
.Caption = '风格切换''设置标题
.BeginGroup = True'设置分组
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)'新建菜单项，下同
With Obj_Toolbar_button'设置菜单项的属性，下同
.Caption = '标准风格'
.BeginGroup = True
.OnAction = 'Standard_Style''设置单击菜单项执行的子程序名称
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)'新建其他的菜单项，并设置属性
With Obj_Toolbar_button
.Caption = '简单风格'
.BeginGroup = True
.OnAction = 'Simple_Style'
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)
With Obj_Toolbar_button
.Caption = '绘图和制表风格'
.BeginGroup = True
.OnAction = 'Draw_Table_Style'
End With
Set Obj_Toolbar_button = Obj_Toolbar.Controls.Add(Type:=msoControlButton, ID:=1)'新建工具栏按钮
With Obj_Toolbar_button'设置按钮的属性
.Caption = '关于'
.Style = msoButtonIconAndCaption
.FaceId = 984
.OnAction = 'Show_Msg'
End With
With Obj_Toolbar'设置工具栏的属性
.Visible = True'工具栏可视
.Enabled = True'工具栏可用
.Position = msoBarTop'工具栏置顶
End With
Set Obj_Menu = Application.CommandBars('Menu Bar').Controls.Add(Type:=msoControlPopup, ID:=1)'在Word XP的主菜单中新建菜单，“Menu Bar”代表Word XP主菜单的名称
With Obj_Menu'设置新建菜单的属性
.Caption = '风格切换'
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)'在新建菜单中添加菜单项，下同
With Obj_Toolbar_button'设置新建菜单项的属性，下同
.Caption = '标准风格'
.BeginGroup = True
.OnAction = 'Standard_Style'
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)'新建其他的菜单项，并设置属性
With Obj_Toolbar_button
.Caption = '简单风格'
.BeginGroup = True
.OnAction = 'Simple_Style'
End With
Set Obj_Toolbar_button = Obj_Menu.Controls.Add(Type:=msoControlButton, ID:=1)
With Obj_Toolbar_button
.Caption = '绘图和制表风格'
.BeginGroup = True
.OnAction = 'Draw_Table_Style'
End With
End Sub
3.编制删除工具栏和菜单的子程序
Sub deletebutton()'删除工具栏和菜单的子程序
Dim tempbar As CommandBar'定义临时工具栏变量
On Error Resume Next'该语句用于忽略错误
Application.CommandBars('Menu Bar').Reset'重新设置Word XP的主菜单，即删除新建的菜单
For Each tempbar In Application.CommandBars'通过“For Each…Next”语句遍历Word XP所有的工具栏
If tempbar.name = 'My_Custom_Bar' Then'如名称和新建的工具栏相同
tempbar.Visible = False'设置为不可视
tempbar.Delete'删除该工具栏
End If
Next
End Sub
取消菜单或工具栏项：
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.Interactive = False
Set objDoc = objWord.CommandBars('File').Controls('打印(&P)...')
objDoc.Visible = False
Set objDoc1 = objWord.CommandBars('Standard').Controls('打印(&P)')
objDoc1.Visible = False
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.CommandBars('Standard').Visible = False
objWord.CommandBars('Formatting').Visible = False
objWord.CommandBars('File').Controls('打印(&P)...').Visible = False
objWord.CommandBars('File').Controls('打印预览(&V)').Visible = False
objWord.CommandBars('Text').Controls(1).Enabled = False
objWord.CommandBars('Text').Controls(2).Enabled = False
objWord.CommandBars('Text').Controls(3).Enabled = False
objWord.CommandBars('Menu Bar').Controls(2).Enabled = False
objWord.CommandBars('Menu Bar').Controls(3).Visible = False
Set objDoc = objWord.Documents.Open('c:\test.doc')
WORD打开后另存为
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.CommandBars('Standard').Visible = True
objWord.CommandBars('Formatting').Visible =True
objWord.CommandBars('File').Controls('打印(&P)...').Visible = False
objWord.CommandBars('File').Controls('打印预览(&V)').Visible = False
objWord.CommandBars('Text').Controls(1).Enabled = False
objWord.CommandBars('Text').Controls(2).Enabled = False
objWord.CommandBars('Text').Controls(3).Enabled = False
objWord.CommandBars('Menu Bar').Controls(2).Enabled = True
objWord.CommandBars('Menu Bar').Controls(3).Visible =True
Set objDoc = objWord.Documents.Open('D:\1223.doc')
Set objWord = Nothing
objWord.Documents.SaveAs'c:\test3.doc'
打印WORD
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.CommandBars('Text').Enabled = False
objWord.CommandBars('Menu Bar').Enabled = False
objWord.CommandBars('Standard').Enabled = False
objWord.CommandBars('Formatting').Enabled =False
Set objDoc = objWord.Documents.Open('c:\test.doc')
objDoc.PrintOut()
objWord.Quit
Set objWord = CreateObject('Word.Application')
objWord.Visible = True
objWord.ListCommands(True)
Set objDoc = objWord.Documents(1)
Set objTable = objDoc.Tables(1)
For i = 1 to objTable.Rows.Count
strText = objTable.Cell(i,2).Range.Text
strText = strText & objTable.Cell(i,3).Range.Text
intLength = Len(strText)
If intLength <= 4="">
objTable.Rows(i).Delete
i = i - 1
End If
Next
Dim wapp As Word.Application
Dim cbc As Object
Set wapp = New Word.Application
wapp.Documents.open 'c:\test.doc'
Set cbc = wapp.CommandBars('Standard').FindControl(, 2520) '新建
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('Standard').FindControl(, 23) '打开
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('Standard').FindControl(, 3) '保存
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('File').FindControl(, 18) '新建
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('File').FindControl(, 23) '打开
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('File').FindControl(, 3) '保存
If Not (cbc Is Nothing) Then cbc.Delete
Set cbc = wapp.CommandBars('File').FindControl(, 748) '另存为
If Not (cbc Is Nothing) Then cbc.Delete
wapp.Visible = True
联系客服
