VBA ExcelリボンのCheckboXに関して教えてください

いつもお世話になります


Office Ribbon Editorを使ってリボンを作り、プログラムを運用しています。
今回、CheckBoxを入れてみました

（Office Ribbon Editor）
<group idQ="Group2" label="Test" autoScale="true" >
　・
<checkBox id="Mychk101" getPressed="CheckBox101_getPressed" onAction="CheckBox101_change" label="TEST" />
　・
</group>

（VBA）
Public IsCheckBox101 As Boolean
Sub CheckBox101_change(control As IRibbonControl, ByRef returnValue)
Select Case control.ID
Case "Mychk101"
IsCheckBox101 = returnValue
End Select
End Sub
Sub CheckBox101_getPressed(control As IRibbonControl, ByRef returnValue)
Select Case control.ID
Case "Mychk101"
returnValue = False
End Select
End Sub

Mainプログラムでは
　If IsCheckBox101 で判定しています

そこで質問ですが、
プログラムを正常に終わらせているときは、CheckBoxのOnOffを保持してくれますが
エラー、デバッグ等で途中終了させるとOnOffがクリアになってしまい、
CheckBoxをクリックしない限り、たとえCheckBoXにチェックマークが入っていても
Falseになってしまいます

立ち上げなおせば問題ないのですが
そのまま実行すると間違った結果になってしまいます

まだ、CheckBoxの運用は始めたばかりなので良くわかりません
UserformではCheckBox.Valueで確認できますが、このようなことは
出来るのでしょうか？

すみません、わかりずらい説明かもしれませんがよろしくお願いいたします

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2019/08/21 21:12

昔、私が作ったコードをそのまま、掲示します。

XMLのアイテム名などは、当然違いますが、参考にされてください。
制作時、どこかのサイトのものを引用及び改造したものと記憶していますが、
どこのサイトだったかは、忘れてしまいました。ちなみにこのツールは現役で基幹業務を行っています。

掲示するコードは、当然一部ですが、プロシージャ、ファンクション単位です。
本件に関係のないものもありますが、読み飛ばしてください。


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

'ドロップダウンリストにデフォルト値を設定
Public Sub dropDown_getSelectedItemID(control As IRibbonControl, ByRef returnedVal)
returnedVal = Worksheets("price_data").Cells(2, 1)
End Sub

この回答へのお礼

いつもありがとうございます

大切なお時間を使わせてしまい恐縮しています
ご回答いただいたコードを元にプログラムの完成度を
高めていきたいと思います

ご親切ご丁寧なご回答に心から感謝します
これからもよろしくお願い申し上げます

お礼日時：2019/08/23 10:17

No.5 回答者： WindFaller 回答日時： 2019/08/22 00:08

UserForm のCheckBox.Valueように、単独では出来たので、いざコードをアップしようとして、元の質問のコードをみて気がついたことですが、複数のCheckBox があって、それをそれぞれ書くというのは、うまくないと思いました。

コードをごちゃごちゃにしないで、まとめ上げるということを考えると、うまく反映しない状態になって、今のところはお手上げ状態になってしまいました。理屈は同じはずなのですが、モジュール・スコープ変数に割り当てるのに、配列してみたのですが、うまくまとまらないので、本日はここまでになりました。

<checkBox
　　id="Mychk101"
　　label="TEST"
　　getPressed="getPressed"
　　onAction="change"/>
<checkBox
　　id="Mychk102"
　　label="TEST2"
　　getPressed="getPressed"
　　onAction="change"/>
<checkBox
　　id="Mychk103"
　　label="TEST3"
　　getPressed="getPressed"
　　onAction="change"/>
　　
これでわかるとおり、CallBack は、3つのコントロールに対して、単独のgetPressed と change のみを使おうと考えました。細かな説明も可能ですが、それは、できていないままで話しをまとめるとツジツマが合わなくなりそうです。

No.4 回答者： Qchan1962 回答日時： 2019/08/21 23:29

ご質問に対しての大事な回答をしておりませんでした。

＞まだ、CheckBoxの運用は始めたばかりなので良くわかりません
＞UserformではCheckBox.Valueで確認できますが、このようなことは出来るのでしょうか？

＝で結ぶ、同様の方法で良いかと思いますが、
先にも示しましたが、リボンのインスタンスをデバックなどで解放してしまった場合（ボタンなどが機能しない）Nothingが返ります。
機能を失った時の値を抽出するには、あらかじめ　Static変数（これも消える可能性はあります）やセルなどに値を持たせる必要があるかと思います。

追記、このコードを書いたFileHistoryを調べたら、Excel2010で2015にファイルは作られ、Excel2013など混在する環境で他の処理がMDIからSDIの移行で不具合があり修正時にリボンのインスタンス問題が発生したので追記したとありました。だいぶ前の事ですが、参考にしたのは、確かめ検索していませんが国内サイトだったと思います。

WindFaller様が案内されている記事を拝見いたしました。回答記事にはなっておりませんが、Fahad Al-Dossary氏が掲示している（’18）コードと同様のものになるのかなと思います。

自分が書いた№1の回答ですが、我ながら、何言っているのか、、酔いと眠気がある中で回答してしまい申し訳ございません。
リボン系の質問回答記事などはあまりなく、自分も苦労した覚えがあったのでついと言う事でした。
№3のコードは、5台のExcel2013,2016で現在も問題なく使っています。（私の作るVBAツールの半分は完全カスタムリボンでファイルタグも開けなくしています）

一応、シートセルに状況や値を書き込んでいるのは、社内基幹業務で運用する自作のツールの為、Excelの仕様変更や環境不具合など万が一VBAに支障がきたした時の保険的処理ですので該当しないかと思います。また、修正処理に関してなのでユーザー名、時間、変更内容など外部ファイルに記録する為ですので忘れてください。

WindFaller様ご指摘の　Custom Property を利用すればよいと思います。
ご指摘の通りだと思います。
また、示したコードは、デフォルト（起動時の値）に戻るので、インスタンスを失った時の値は、セル？　Custom Propertyも失った時の値は、、
忘れてしまっている事も沢山あるので、やめます。

公共ごま様、脱線したコメントになりました。すみません。

この回答へのお礼

いつもおせわになります

皆様から頂いたご回答、これからじっくりと勉強させていただきます
まだまだ未熟なため時間がかかりそうです
感謝の気持ちを持ちひとつひとつ紐解いて行きたいと思いますので
まずはお礼まで

本当にありがとうございました
これからもよろしくお願い申し上げます

お礼日時：2019/08/23 10:26

No.2 回答者： WindFaller 回答日時： 2019/08/21 09:54

おっしゃていることは分かっているつもりではいるのですが、若干、その現象に対して、もしかしたら、認識が違っているかもしれません。

>プログラムを正常に終わらせているときは、CheckBoxのOnOffを保持してくれますが
とありますが、値は保持しているのですが、別に設けたタブに入れた時に、チェックマークが消えてしまっています。

以下の掲示板(google翻訳)
//stackoverflow https://stackoverflow.com/questions/17429500/che …
vbaコードを実行するxml（Microsoft OfficeのカスタムUIエディターを使用）を使用して、リボンにcheckBoxを追加します。アプリケーションを閉じても、この値を維持するためにこのチェックボックスが必要です（チェックされているかどうか）。今、それを閉じて開くと、checkBoxは常にオフになっています。//

この通りです。この問題が解決しません。値は、どうやら保持されていることは分かりましたが、tick(チェックマーク)が消えてしまいます。

もちろん、値自体は記録に残すことは可能ですから、中途でマクロが中断しても問題がありませんが、そのtick を、内部の値と一致させる方法が分かりません。上記のStackOverFlowのように、あまり面倒なことはしたくありません。仮にできても、その維持しにくいですから。Value値のようなプロパティがわからないのです。

どうも、昔のOLE コントロールような独立性がありません。

なお、今の所公開するつもりはありませんでしたが、No.1さんの回答に関しては、Custom Property を利用すればよいと思います。レジストリでも構いませんが、Book自体に書き込むなら、この程度でよろしいかと思います。もちろん、シート上でも問題はありませんが、今、それは後回しです。

この回答へのお礼

こんにちは
いつもありがとうございます

皆様の技術力に驚くことと共に
親切丁寧なご回答に心から感謝しています

これからもよろしくお願いいたします

お礼日時：2019/08/23 10:12

No.1 回答者： Qchan1962 回答日時： 2019/08/21 03:58

深夜でちゃんとした回答ではないですが、リボンがインスタンスを放してしまうとリボンは機能しなくなったかと思います。

起動時にレジストリに書き込み、リボンが機能しない時（Nothing)にはレジストリから再度読み込むようなコードを書いた覚えがあります。

明日の夜少し時間があるので、昔作ったファイルを確認してみます。
あと、その時の仕様の関係で起動時にチェックボックスの値やドロップダウンの値を設定シートを作り書き込んでたかと思います。

Sub checkBox_change(control As IRibbonControl, ByRef returnValue)
Select Case control.id
Case "chk1"
IsCheckBox1 = returnValue
Worksheets("Item_data").Cells(1, 2).Value = "通常処理中"
IsCheckBox2 = False
Case "chk2"
IsCheckBox2 = returnValue
Worksheets("Item_data").Cells(1, 2).Value = "修正処理中"
IsCheckBox1 = False
' Case "chk3"
' IsCheckBox3 = returnValue
End Select
myRibbon.Invalidate
End Sub
リボン系の記事は、少ないですが（レジストリから再度読み）どこかにあったと思います。
さすがにやばい時間なので、一旦失礼します。

この回答へのお礼

おはようございます
いつも本当にありがとうございます

ゆっくり休んでくださいね
続きの記事、楽しみに待ってます

猛暑の続くこの頃、大切なお身体
くれぐれもご自愛のほどお願い申し上げます

お礼日時：2019/08/21 09:21