2010/10/19

access2010 access2007 RibbonUI設定の共通化

いろいろ考えるとややこしいのでパターンだけメモ
onActionを =OptionOnClick() としているのでOfficeObjectLibraryの参照はなくてもいい。
2010で製造時14.0を参照していても、2007が12.0に読み替えてるから(思い込みじゃないか)、コールバックでもいい。
2007はofficeMenu/2010はbackStageを振り分ける。contextualTabsもあったかな。

カレントデータベースのリボン名を予め設定
AutoExecでCreateRibbonを実行
今のところ無事作動。
とはいえ、あんまり使えないか。ソースコードありきの互換性だし。
#if vba6 = 1 then
const flg = 0
#else
const flg = -1
#end if
にして、a2007でaccde化したらa2010(32)でも動くかもしれん。

Option Compare Database
Option Explicit

#If VBA7 = 1 Then
    Const flg = -1
#Else
    Const flg = 0
#End If

Public Function OptionOnClick()
    MsgBox "OptionButtonClick"
End Function

Function CreateRibbon()

On Error GoTo ErrHnd

    Dim xdoc As New DOMDocument
    Dim xelem(10) As IXMLDOMElement

    Set xelem(0) = xdoc.createElement("customUI")
    If flg Then
        xelem(0).setAttribute "xmlns", "http://schemas.microsoft.com/office/2009/07/customui"
    Else
        xelem(0).setAttribute "xmlns", "http://schemas.microsoft.com/office/2006/01/customui"
    End If
    xdoc.appendChild xelem(0)
    
    Set xelem(1) = xdoc.createElement("commands")
    xelem(0).appendChild xelem(1)
    
    Set xelem(2) = xdoc.createElement("command")
    xelem(2).setAttribute "idMso", "ApplicationOptionsDialog"
    xelem(2).setAttribute "onAction", "=OptionOnClick()"
    xelem(1).appendChild xelem(2)
    
    Set xelem(1) = xdoc.createElement("ribbon")
    xelem(1).setAttribute "startFromScratch", "true"
    xelem(0).appendChild xelem(1)
    
'    Debug.Print xdoc.XML
    Application.LoadCustomUI "backoffice", xdoc.XML
Done:
    Exit Function
ErrHnd:
    If Err.Number <> 32609 Then MsgBox Err.Number & vbCrLf & Err.Description
End Function

0 件のコメント: