0度跨越

微软Office 2007中新增了一个十分有用的工具：对象选择窗格。这个插件模仿了它的所有功能并打算在其后续版本中加入更实用更快捷的功能，如对象的批量命名，对象层次顺序的拖拉式调整等。目前的版本只支持在WPP中操作，后续版本将支持Wps和Et。

由于Wps 2009所提供的对象模型还不是很成熟，很多属性和方法还没有实现，所以其中采用了许多的折衷解决方案，本来两三个小时可以完成的插件，结果实际花费了近5个小时，看来在Wps中进行开发不是一件很轻松的事情，Wps团队还需加油啊。

这个插件没有提供Wps插件平台安装的方式（当然，您自己可以写写插件平台的安装脚本）。

（1）安装
把文件解压到某个目录，双击该目录中的install.cmd文件，即安装成功。

（2）卸载
双击目录中的Uninstall.cmd文件，然后删除目录，即卸载成功。

插件下载：暂时停止下载

揭密Wps 2009 命令栏控件类型

1	KsoControlActiveX	ActiveX 控件
2	KsoControlButton
3	KsoControlButtonDropdown
4	KsoControlButtonPopup
5	KsoControlComboBox
6	KsoControlCustom	特性保留
7	KsoControlDropdown
8	KsoControlEdit
9	KsoControlExpandingGrid
10	KsoControlGauge
11	KsoControlGenericDropdown	特性保留
12	KsoControlGraphicCombo
13	KsoControlGraphicDropdown
14	KsoControlGraphicPopup	特性保留
15	KsoControlGrid
16	KsoControlLabel
17	KsoControlOCXDropDown
18	KsoControlPane	面板控件
19	KsoControlPopup
20	KsoControlSplitButtonMRUPopup
21	KsoControlSplitButtonPopup
22	KsoControlSplitDropdown
23	KsoControlSplitExpandingGrid	特性保留

尽管Wps 2009内置了这么多的控件，但实际上可供我们使用的却并不多，主要有下面几种：

u 按钮 (KsoControlButton) 

u 弹出式菜单 (KsoControlPopup) 

u 文字框 (KsoControlEdit) 

u 下拉列表 (KsoControlDropdown) 

u 组合框 (KsoControlComboBox) 

u 标签 (KsoControlLabel)

其他的控件只供Wps 2009内部使用，如果你企图去建构它，将会产生一个错误消息。

在Wps2009中进行开发时，或许有时候您并不想自己动手去制作图标，而是想直接利用其中丰富的图标资源，就如微软Office一样，可是Wps并没有资料告诉您所需要图标的ID，也正因为如此，为了方便查找，我写了一个这样的用来在Wps中查询图标的插件，一是为了找找在Wps中开发的感觉，二是有这方面的需要。

这个插件没有提供Wps插件平台安装的方式（当然，您自己可以写写插件平台的安装脚本）。

（1）安装
把文件解压到某个目录，双击该目录中的install.cmd文件，即安装成功。

（2）卸载
双击目录中的Uninstall.cmd文件，然后删除目录，即卸载成功。

插件下载:http://www.brsbox.com/filebox/down/fc/cfec1ce7a4259194c254227c3b0cfd82

学习写作一个PPT插件

在PowerPoint2003中，当你插入一个Shape（图形）时，PowerPoint会傻乎乎地给Shape命名为诸如：矩形1，矩形2……，看着这一大堆一模一样的孪生兄弟，我们都搞不清楚谁是谁了，即使是微软自己也一定为搞不清楚而苦恼，因此在PowerPoint2007中才提供了一个叫做“选择窗格”的东西，不过这东西还是有点问题：它不能用拖动的方式来调整对象的叠放顺序。

下面我们就分系列来写作一个能在PowerPoint2003中重命名对象、显示/隐藏对象、快速调整对象叠放顺序的插件，希望朋友们能通过这样一个实例的操作快速地入门PPT插件的开发。

一、给所选对象重命名

（1）建立一个PPT文档

（2）按Alt+F11打开VBA编程环境。

（3）选择“插入”->“类模块”，并把这个类模块命名为“clsApp”

（4）在类模块中输入下列代码：

Public WithEvents App As Application '声明一个响应事件的PPT程序对象App
Public ActiveObj As Object

Private Sub App_SlideSelectionChanged(ByVal SldRange As SlideRange)
If ActivePresentation.ReadOnly Then Exit Sub '如果演示文稿只读则退出。
    If SldRange.Count = 1 Then '如果没有选择多张幻灯片，这样就可以对所选择的幻灯片进行重命名
        cbMenu.Controls("Edit").Text = SldRange.Name
        Set ActiveObj = SldRange
    Else
        cbMenu.Controls("Edit").Text = ""
        Set ActiveObj = Nothing
    End If
End Sub

Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
If ActivePresentation.ReadOnly Then Exit Sub
    Select Case Sel.Type '判断选区类型
        Case ppSelectionText '选择的是文本框
            cbMenu.Controls("Edit").Text = Sel.ShapeRange.Name
            Set ActiveObj = Sel.ShapeRange
        Case ppSelectionShapes '选择的是Shape
            If Sel.ShapeRange.Count = 1 Then '只能选一个Shape，否则出错
                cbMenu.Controls("Edit").Text = Sel.ShapeRange.Name
                Set ActiveObj = Sel.ShapeRange
            Else
                cbMenu.Controls("Edit").Text = ""
                Set ActiveObj = Nothing
            End If
        Case ppSelectionNone '什么也没有选
            cbMenu.Controls("Edit").Text = ""
            Set ActiveObj = Nothing
    End Select
End Sub

（5）插入一个模块并命名为mdApp，输入下列代码：

Public clsApp As New clsApp '声明刚才插入的类模块的实例clsapp
Public cbMenu As CommandBar '声明一个命令栏对象

'下面是两个自动运行的宏，这个宏只在PPA中才有效。
Sub Auto_Open()
    Set clsApp.App = Application '把当前的程序实例与类中的App对象进行关联
    CreateMenu '建立工具栏
End Sub

Sub Auto_Close()
On Error Resume Next
    CommandBars("Name Tools").Delete '退出程序时删除建立的命令栏
    End
End Sub

'###############################
'建立命令栏的子过程
'###############################
Sub CreateMenu()
    On Error Resume Next
    CommandBars("Name Tools").Delete
    Err.Clear
    Dim cbCtl As CommandBarControl '声明一个命令栏上的控件

    Set cbMenu = CommandBars.Add("Name Tools") '增加一个叫做"Name Tools"的命令栏
        With cbMenu.Controls.Add(msoControlEdit) '在这个命令栏上增加一个Edit控件
            .Caption = "Edit"
            .OnAction = "Change" '响应动作：Change
        End With
    cbMenu.Visible = True '让命令栏可见
End Sub

'#########################################
'给所选择的对象重命名的子过程
'#########################################
Sub Change()
    On Error Resume Next
    With cbMenu.Controls("Edit")
        If .Text = "" Then: .Text = clsApp.ActiveObj.Name '把所选择对象的名字显示在文框中
        clsApp.ActiveObj.Name = .Text '输入名字并按下回车给对象重命名
        Select Case Err '捕捉错误信息并进行处理
            Case 70
                ActiveWindow.Selection.SlideRange.Shapes(.Text).Select
            Case -2147188160
                ActivePresentation.Slides(.Text).Select
        End Select
    End With
End Sub

（6）在PowerPoint中选择“文件”->“另存为”，“保存类型”选择“PowerPoint 加载宏（*.ppa）”，一个给对象重命名的插件就做好了。

（7）测试效果，在PowerPoint中，选择“工具”->“加载宏”，然后浏览至你刚才保存的文件就可以加载我们刚才编写的插件了。

示例插件下载：http://www.brsbox.com/filebox/down/fc/b68fb4ee97cce3b08c5255d58b872410

下一讲，我将改写上面的代码，把它放入到一个窗体中，从而实现命名的批量功能和对象的显示/隐藏功能。

设置和获取幻灯片的大小

Sub SetSlideSize()
      ' 这个常数用于把单位设为英寸
      Const PTS As Byte = 72
      With ActivePresentation.PageSetup
         .SlideWidth = 8 * PTS '8英寸
         .SlideHeight = 6 * PTS
      End With
   End Sub

Sub GetSlideSize()
      Dim Width As Single
      Dim Height As Single
      With ActivePresentation.PageSetup
         Width = .SlideWidth
         Height = .SlideHeight
      End With
      MsgBox "幻灯片的宽度是： " & (Width / 72) & "英寸，高度是： " _
         & (Height / 72) & "英寸。"
   End Sub