VBA リボンのCheckBox２個をOptionButtonの代わりで描画更新が上手く行かない

いつもお世話になります

今、リボンにCheckBoxを二個並べてOprionButtonのように入り切りをしたいのですが
myRibbon.Invalidate でどうして二つ目のCheckBoxが消えてしまいます
原因が分からないので教えてください

（XML)
<?xml version="1.0" encoding="utf-8"?>
<customUI onLoad="Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2009/07/cust … xmlns:nsShared="rbnShared">
<ribbon>
<tabs>
<tab idQ="nsShared:customTab1" label="公共アプリ-Civil">
<group idQ="nsShared:customGroup13" label="チェックボックステスト" autoScale="true" >
<checkBox id="MyChoice01" getPressed="checkBox002_getPressed" onAction="checkBox002_change" label="CheckBox1"/>
<checkBox id="MyChoice02" getPressed="checkBox002_getPressed" onAction="checkBox002_change" label="CheckBox2"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>

(VBA)
Option Explicit
Public myRibbon As IRibbonUI
Public IsCheckBox201 As Boolean
Public IsCheckBox202 As Boolean

Sub Ribbon_onLoad(ribbon As IRibbonUI)

Set myRibbon = ribbon

End Sub
Sub CheckBox002_change(control As IRibbonControl, returnValue As Boolean)
Select Case control.ID
Case "MyChoice01"
IsCheckBox201 = returnValue
If IsCheckBox201 = True Then
IsCheckBox202 = False
Else
IsCheckBox202 = True
End If
Case "MyChoice02"
IsCheckBox202 = returnValue
If IsCheckBox202 = True Then
IsCheckBox201 = False
Else
IsCheckBox201 = True
End If
End Select
myRibbon.Invalidate ' リボンの描画を更新する
'myRibbon.InvalidateControl ("MyChoice01")
'myRibbon.InvalidateControl ("MyChoice02")
End Sub
Sub CheckBox002_getPressed(control As IRibbonControl, ByRef returnValue)
Select Case control.ID
Case "MyChoice01"
returnValue = IsCheckBox201
Case "MyChice02"
returnValue = IsCheckBox202
End Select
End Sub

以上、よろしくお願い申し上げます

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2019/12/14 12:16

こんにちは、私が作ったもので似たようなものがありますのでコードを示します。

参考にされてください。
ご質問の内容コードが正しいと仮定（検証してません）した場合、リボンのインスタンスが失われた時の現象かもしてません。
野暮用で離れますので、取り敢えずコード該当部分です。ご質問のコントロール名にしていませんが何を行っているかはわかると思います。

XML

<customUI onLoad="Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2009/07/cust …
<ribbon startFromScratch="true">
<tabs>
　　<tab idMso="TabHome" visible="false">
　　　　<group idMso="GroupClipboard" visible="false"/>
　　　　<group idMso="GroupFont" visible="true"/>
　　　　<group idMso="GroupAlignmentExcel" visible="false"/>
　　　　<group idMso="GroupNumber" visible="false"/>
　　　　<group idMso="GroupStyles" visible="false"/>
　　　　<group idMso="GroupCells" visible="false"/>
　　　　<group idMso="GroupEditingExcel" visible="false"/>
</tab>
　　<tab idMso="TabInsert">
<group idMso="GroupInsertTablesExcel" visible="true" />
　　</tab>

　　　・
　　　・略
　　　・

<group id="grp2" label="-　処理モード変更　-">
<checkBox id="chk1" getPressed="checkBox_getPressed" onAction="checkBox_change" label="通常モード"/>
<checkBox id="chk2" getPressed="checkBox_getPressed" onAction="checkBox_change" label="修正モード"/>
</group>

　　　・
　　　・略
　　　・

VBA

Option Explicit
Dim dropDown1 As String, dropDown1Idex As Integer
Dim IsCheckBox1 As Boolean, IsCheckBox2 As Boolean, B As Boolean
Dim csv_name As String, sheet_name As String, maker_name As String
Dim rc As Integer, Status As String
Private myRibbon As IRibbonUI
Private flgChk As Boolean
#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
#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

Sub Ribbon_onLoad(ribbon As IRibbonUI)
　　Set myRibbon = ribbon
　　SaveSetting "RibbonApp", "Main", "RibbonPointer", CStr(ObjPtr(ribbon))　　'リボンのポインタをレジストリに記録
　　flgChk = True
End Sub

Sub Start(ByVal control As IRibbonControl)
　　Application.Run control.id
End Sub

Sub checkBox_change(control As IRibbonControl, ByRef returnValue)
Dim Label As String
　　Call Events_false
　　Select Case control.id
　　Case "chk1"
　　　　IsCheckBox1 = returnValue
　　　　Worksheets("Item_data").Cells(1, 3).Value = "通常処理中"
　　　　IsCheckBox2 = False
　　Case "chk2"
　　　　IsCheckBox2 = returnValue
　　　　Worksheets("Item_data").Cells(1, 3).Value = "修正処理中"
　　　　IsCheckBox1 = False
　　'　　Case "chk3"
　　'　　　IsCheckBox3 = returnValue
　　' 略・・・
　　End Select
　　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.Invalidate
　　Call Events_true
End Sub

Public Sub button_getVisible(control As IRibbonControl, ByRef returnedVal)
　　returnedVal = flgChk
End Sub

Sub checkBox_getPressed(control As IRibbonControl, ByRef returnValue)
　　Select Case control.id
　　Case "chk1"
　　　　returnValue = IsCheckBox1
　　Case "chk2"
　　　　returnValue = IsCheckBox2
　　End Select
End Sub

この回答へのお礼

こんにちは
いつもお世話になります

早速のご回答ありがとうございます
お答えいただいた資料、来週での検討になると思いますが
心から感謝申し上げます
これからもよろしくお願い申し上げます

まずはお礼まで

お礼日時：2019/12/14 12:43