加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

RibbonX制作Excel个性化选项卡

(2011-10-08 17:11:08)
标签:

选项卡

回调函数

底部

移动

模块

分类: Excel_GTD

看到两个网页,介绍制作Excel个性化选项卡,几个简单的例子,会了这几个,基本的定制功能就差不多了。

网页参考:

RibbonX控件回调函数实例http://www.360doc.com/content/11/0324/14/1244775_104189999.shtml

在Excel 2007中制作个性化选项卡http://tech.ddvip.com/2008-09/122257498172301_3.html

 

把两个网页介绍的东西整合到一个里面了,最后效果如下

image

新建一个xlsm文件,添加Custom UI的xml,添加如下代码

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="rxcustomUI_onLoad">
    <ribbon>
        <tabs>
            <tab id="customTab" label="Contoso" insertAfterMso="TabHome">
                <group id="customGroup" label="Contoso Tools">
                    <button id="customButton1" label="ConBold" size="large" onAction="conBoldSub" imageMso="Bold" supertip="This is supertip"/>
                    <button id="customButton2" label="ConItalic" size="large" onAction="conItalicSub" imageMso="Italic" />
                    <button id="customButton3" label="ConUnderline" size="large" onAction="conUnderlineSub" imageMso="Underline" />
                </group>
                <group id="rxMoveCell" label="单元格移动" >
                    <splitButton id="rxSplit" size="large" >
                        <button id="rxButton" getImage="rxButton_getImage" getLabel="rxButton_getLabel" getSupertip="rxButton_getSupertip" onAction="rxButton_onAction" />
                        <menu id="rxMenu" >
                            <button id="rxMenuTop" label="顶部" imageMso="FillUp" onAction="rxMenu_onAction" />
                            <button id="rxMenuLeft" label="左侧" imageMso="FillLeft" onAction="rxMenu_onAction" />
                            <button id="rxMenuRight" label="右侧" imageMso="FillRight" onAction="rxMenu_onAction" />
                            <button id="rxMenuBottom" label="底部" imageMso="FillDown" onAction="rxMenu_onAction" />
                        </menu>
                    </splitButton>
                </group>
               
                <group id="Group1" label="Stuff" >
                    <labelControl id="Label1" getLabel="getLabel1" />
                    <labelControl id="Label2" getLabel="getLabel2" />
                    <editBox id="EditBox1" showLabel="true" label="Number:" onChange="EditBox1_Change" />
                    <button id="Button1" label="Calculator" imageMso="Calculator" onAction="ShowCalculator" />
                </group>
               
                <group id="Group2" label="More Stuff">
                    <toggleButton id="ToggleButton1" size="large" imageMso="FileManageMenu" label="Toggle Me" onAction="ToggleButton1_Click" />
                    <separator id="sep1" />
                    <checkBox id="Checkbox1" label="Checkbox" onAction="Checkbox1_Change"/>
                    <comboBox id="Combo1" label="Month" onChange="Combo1_Change">
                        <item id="Month1" label="January" />
                        <item id="Month2" label="February"/>
                        <item id="Month3" label="March"/>
                        <item id="Month4" label="April"/>
                        <item id="Month5" label="May"/>
                        <item id="Month6" label="June"/>
                        <item id="Month7" label="July"/>
                        <item id="Month8" label="August"/>
                        <item id="Month9" label="September"/>
                        <item id="Month10" label="October"/>
                        <item id="Month11" label="November"/>
                        <item id="Month12" label="December"/>
                    </comboBox>
                </group>                   
               
                <group id="Group4" label="Galleries" >
                    <gallery id="Gallery1" imageMso="ViewAppointmentInCalendar" label="Pick a Month:" columns="2" rows="6" onAction="MonthSelected" size="large">
                        <item id="January" label="January" supertip="this is a tip" imageMso="QuerySelectQueryType" />
                        <item id="February" label="February" imageMso="QuerySelectQueryType" />
                        <item id="March" label="March" imageMso="QuerySelectQueryType" />
                        <item id="April" label="April" imageMso="QuerySelectQueryType" />
                        <button id="Today" label="Today…" imageMso="ViewAppointmentInCalendar" onAction="ShowToday" />
                    </gallery>
                </group>
               
            </tab>
        </tabs>
    </ribbon>
</customUI>

 

在VBA中添加模块,粘贴如下代码

Dim moRibbon As IRibbonUI   '模块变量,获取对Ribbon的引用
Dim str1 As String          '模块变量,保存当前按钮的状态

Sub rxcustomUI_onLoad(ribbon As IRibbonUI)
Set moRibbon = ribbon '获取对Ribbon的引用
End Sub
' 第二组
Sub rxButton_getImage(control As IRibbonControl, ByRef returnedVal)
    If str1 = "" Then str1 = "Right"
   
    Select Case str1
        Case "Top"
            returnedVal = "FillUp"
        Case "Left"
            returnedVal = "FillLeft"
        Case "Right"
            returnedVal = "FillRight"
        Case "Bottom"
            returnedVal = "FillDown"
        End Select
End Sub
Sub rxButton_getLabel(ByRef control As IRibbonControl, ByRef ReturnValue As Variant)
    If str1 = "" Then str1 = "Right"
   
    Select Case str1
        Case "Top"
            ReturnValue = "顶部"
        Case "Left"
            ReturnValue = "左侧"
        Case "Right"
            ReturnValue = "右侧"
        Case "Bottom"
            ReturnValue = "底部"
    End Select
End Sub
Sub rxButton_getSupertip(ByRef control As IRibbonControl, ByRef ReturnValue As Variant)
    If str1 = "" Then str1 = "Right"
   
    Select Case str1
        Case "Top"
            ReturnValue = "移动到区域顶部"
        Case "Left"
            ReturnValue = "移动到区域左侧"
        Case "Right"
            ReturnValue = "移动到区域右侧"
        Case "Bottom"
            ReturnValue = "移动到区域底部"
    End Select
End Sub
Sub rxButton_onAction(control As IRibbonControl)
DoGoto str1
End Sub
Private Sub DoGoto(ByVal sStyle As String)
Select Case sStyle
    Case "Top"
        ActiveCell.End(xlUp).Select
    Case "Left"
        ActiveCell.End(xlToLeft).Select
    Case "Right"
        ActiveCell.End(xlToRight).Select
    Case "Bottom"
        ActiveCell.End(xlDown).Select
End Select
End Sub

Sub rxMenu_onAction(control As IRibbonControl)
str1 = Mid$(control.id, 7)
moRibbon.InvalidateControl "rxButton" '更新按钮控件
DoGoto str1
End Sub


' 第三组
Sub getLabel1(control As IRibbonControl, ByRef returnedVal)
    returnedVal = "Hello " & Application.UserName
End Sub
Sub getLabel2(control As IRibbonControl, ByRef returnedVal)
    returnedVal = "Today is " & Date
End Sub
Sub EditBox1_Change(control As IRibbonControl, text As String)
    Dim squareRoot As Double
    On Error Resume Next
    squareRoot = Sqr(text)
    If Err.Number = 0 Then
        MsgBox text & "的平方根是:" & squareRoot
    Else
        MsgBox "输入了一个负数.", vbCritical
    End If
End Sub
Sub ShowCalculator(control As IRibbonControl)
    On Error Resume Next
    Shell "calc.exe", vbNormalFocus
    If Err.Number <> 0 Then MsgBox "不能开启calc.exe"
End Sub
' 第四组
Sub ToggleButton1_Click(control As IRibbonControl, ByRef returnedVal)
    MsgBox "Toggle value: " & returnedVal
End Sub
Sub Checkbox1_Change(control As IRibbonControl, pressed As Boolean)
    MsgBox "Checkbox value: " & pressed
End Sub
Sub Combo1_Change(control As IRibbonControl, text As String)
    MsgBox text
End Sub
' 第五组
Sub MonthSelected(control As IRibbonControl, id As String, index As Integer)
    MsgBox "You selected " & id
End Sub
Sub ShowToday(control As IRibbonControl)
    MsgBox "Today is " & Date
End Sub

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有