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 件のコメント:
コメントを投稿