IRibbonUIオブジェクトがNothingになったときの対処法

例えばリボン要素の表示・非表示を動的に切り替えたい場合、通常は下記コードのようにgetVisible属性のコールバックで表示設定をして、IRibbonUIオブジェクトのInvalidateやInvalidateControlメソッドを使ってリボンを再描画します。

[標準モジュール]


                        Option Explicit

                        

                        Private myRibbon As Office.IRibbonUI

                        Private flg As Boolean

                        

                        Public Sub Ribbon_onLoad(ribbon As IRibbonUI)

                          Set myRibbon = ribbon

                          flg = True

                        End Sub

                        

                        Public Sub button_onAction(control As IRibbonControl)

                          flg = Not flg

                          myRibbon.InvalidateControl "myTestButton"

                        End Sub

                        

                        Public Sub button_getVisible(control As IRibbonControl, ByRef returnedVal)

                          returnedVal = flg

                        End Sub

[リボンXML]


                        <?xml version="1.0" encoding="utf-8"?>

                        <customUI onLoad="Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">

                          <ribbon>

                            <tabs>

                              <tab id="myTab" label="My Tab">

                                <group id="myGroup" label="My Group">

                                  <button id="myButton" label="My Button" size="large" imageMso="HappyFace" onAction="button_onAction" />

                                  <button id="myTestButton" label="Test Button" size="large" imageMso="SadFace" getVisible="button_getVisible" />

                                </group>

                              </tab>

                            </tabs>

                          </ribbon>

                        </customUI>

しかしデザインモードにした場合等何らかの拍子で、customUI要素のonLoad属性のコールバックでSetしたIRibbonUIオブジェクトがNothingになってしまう場合があります。

海外のMS MVPであるRon de Bruinさんのサイトにその対処法が書かれていたので、今回はそれを紹介します(一部コードは変更してあります)。

[標準モジュール]


                        Option Explicit

                        

                        #If VBA7 And Win64 Then

                          Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal cbLen As LongPtr)

                        #Else

                          Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal cbLen As Long)

                        #End If

                        

                        Private myRibbon As Office.IRibbonUI

                        Private flg As Boolean

                        

                        Public Sub Ribbon_onLoad(ribbon As IRibbonUI)

                          Set myRibbon = ribbon

                          SaveSetting "RibbonApp", "Main", "RibbonPointer", CStr(ObjPtr(ribbon)) 'リボンのポインタをレジストリに記録

                          flg = True

                        End Sub

                        

                        Public Sub button_onAction(control As IRibbonControl)

                          flg = Not flg

                          If myRibbon Is Nothing Then

                            MsgBox "IRibbonUIオブジェクトがNothingです。" & vbCrLf & "保持していた値からSetします。", vbExclamation + vbSystemModal

                            #If VBA7 And Win64 Then

                              Set myRibbon = GetRibbon(CLngPtr(GetSetting("RibbonApp", "Main", "RibbonPointer")))

                            #Else

                              Set myRibbon = GetRibbon(CLng(GetSetting("RibbonApp", "Main", "RibbonPointer")))

                            #End If

                          End If

                          myRibbon.InvalidateControl "myTestButton"

                        End Sub

                        

                        Public Sub button_getVisible(control As IRibbonControl, ByRef returnedVal)

                          returnedVal = flg

                        End Sub

                        

                        #If VBA7 And Win64 Then

                        Private Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object

                          Dim p As LongPtr

                        #Else

                        Private Function GetRibbon(ByVal lRibbonPointer As Long) As Object

                          Dim p As Long

                        #End If

                          Dim ribbonObj As Object

                          

                          MoveMemory ribbonObj, lRibbonPointer, LenB(lRibbonPointer)

                          Set GetRibbon = ribbonObj

                          p = 0: MoveMemory ribbonObj, p, LenB(p) '後始末

                        End Function

上記のように、ObjPtr関数でオブジェクトのポインタを取得しておいて、IRibbonUIオブジェクトがNothingだった場合には取得しておいたポインタをObject変数に書き込むことで対応することができます。

参考Webページ：
「loss of state of the global IRibbonUI Ribbon object」
http://www.rondebruin.nl/ribbonstate.htm