• 2009-10-25

    学习写作一个PPT插件(入门级) - [PPT插件设计]

    版权声明:转载时请以超链接形式标明文章原始出处和作者信息及本声明
    http://www.blogbus.com/pptaddins-logs/49143130.html

    学习写作一个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

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

    分享到:

    评论

  • 这段代码在07中貌似不能用哎