カスタム検索
リボン関連

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