2010/11/13

access2010 Ribbon dynamicMenu


そのまんまで、dynamicなMenuということ。
dynamicMenu要素には、getContent属性が必須で、このコールバックでメニュー表示に必要なRibbonXmlを取得する。子要素はmenuと同じで、

<menu xmlns="http://schemas.microsoft.com/office/2009/07/customui">
   <!--menu子要素-->
</menu>

のXmlを用意してあげないとならない。
invalidateContentOnDrop属性をtrueにすることでメニュー展開時にコールバックを要求してくる。
どんな方法でもいいからRibbonXmlを返せばいい。
<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
  <ribbon>
    <tabs>
      <tab id="tab01" label="タブ01">
        <group id="g01" label="グループ01">
          <dynamicMenu id="dm01" 
                       getContent="getContent" 
                       size="large" 
                       imageMso="CreateForm"
                       label="ダイナミックメニュー" 
                       invalidateContentOnDrop="true" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
Option Compare Database
Option Explicit

Sub getContent(ctr As IRibbonControl, rtnXml)
    rtnXml = CreateContents
End Sub

Sub onAction(ctr As IRibbonControl)
    MsgBox ctr.id & vbTab & ctr.Tag
End Sub

Private Function CreateContents()
    Dim xdoc As New DOMDocument
    Dim xelem(1) As IXMLDOMElement
    Dim objCount As Integer, i As Integer
    Dim dbs As Database, accdoc As Document
    
    Set dbs = CurrentDb
    
    Set xelem(0) = xdoc.createElement("menu")
    xelem(0).setAttribute "xmlns", "http://schemas.microsoft.com/office/2009/07/customui"
    xelem(0).setAttribute "itemSize", "large"
    xdoc.appendChild xelem(0)
    
    objCount = dbs.Containers("Forms").Documents.Count
    
    If objCount > 0 Then
        Set xelem(1) = xdoc.createElement("menuSeparator")
        xelem(1).setAttribute "id", "sep01"
        xelem(1).setAttribute "title", "フォーム"
        xelem(0).appendChild xelem(1)
        For i = 0 To objCount - 1
            Set accdoc = dbs.Containers("Forms").Documents(i)
            Set xelem(1) = xdoc.createElement("button")
            With xelem(1)
                .setAttribute "id", "form" & Format(i, "00")
                .setAttribute "label", accdoc.Name
                .setAttribute "tag", accdoc.Name
                .setAttribute "imageMso", "CreateForm"
                .setAttribute "onAction", "onAction"
                .setAttribute "description", docDescription(accdoc)
            End With
            xelem(0).appendChild xelem(1)
        Next
    End If
    
    CreateContents = xdoc.XML
'    Debug.Print xdoc.XML
    
    Set xdoc = Nothing
    Set dbs = Nothing
End Function

Private Function docDescription(doc As Document) As String
On Error GoTo ErrHnd
    docDescription = Nz(doc.Properties("Description"), " ")
Exit Function
ErrHnd:
    docDescription = " "
End Function
<menu xmlns="http://schemas.microsoft.com/office/2009/07/customui" itemSize="large"><menuSeparator id="sep01" title="フォーム"/>
<button id="form00" label="フォーム1" tag="フォーム1" imageMso="CreateForm" onAction="onAction" description="DescriptionDescription"/>
<button id="form01" label="フォーム2" tag="フォーム2" imageMso="CreateForm" onAction="onAction" description=" "/>
<button id="form02" label="フォーム3" tag="フォーム3" imageMso="CreateForm" onAction="onAction" description="DescriptionDescription"/>
<button id="form03" label="フォーム4" tag="フォーム4" imageMso="CreateForm" onAction="onAction" description="DescriptionDescription"/>
<button id="form04" label="フォーム5" tag="フォーム5" imageMso="CreateForm" onAction="onAction" description=" "/>
</menu>

0 件のコメント: