Wordのリボンに読み取り専用の切替えボタンを追加する

Option Explicit

'**********************************************************
'*　現在のファイルを閉じて、読み取り専用で開きなおす
'**********************************************************
Sub ReadOnlySwitch()
    With ActiveDocument
        If .Saved = False Then
            '未保存のファイルならダイアログを表示
            Dim rc As Long
            rc = MsgBox("保存されていない変更があります。" & Chr(13) & "保存しますか？", vbYesNoCancel + vbQuestion)
            
            If rc = 6 Then
                '「はい」が選択された場合、上書き保存して続行
                .Save
            ElseIf rc = 7 Then
                '「いいえ」が選択された場合、何もせずに続行
            ElseIf rc = 2 Then
                '「キャンセル」が選択された場合、戻る
                Exit Sub
            End If
        End If
    
        Dim path As String: path = .FullName
        Dim isReadOnly As Boolean: isReadOnly = Not .ReadOnly
        '上書きせずに一度閉じる
        Call .Close(SaveChanges:=wdDoNotSaveChanges)
    End With
    
    '開きなおして印刷レイアウトで表示
    Dim doc As Document: Set doc = Documents.Open(FileName:=path, ReadOnly:=isReadOnly)
    doc.ActiveWindow.View.Type = wdPrintView
End Sub

'**********************************************************
'*　コマンドバーを作成する
'**********************************************************

Sub CreateCommandBar()
    Dim myToolBar As CommandBar
    Dim myCbarCtl As CommandBarControl
    Dim myCbarName As String
    
    'myBar()の数字で、ボタンの数を定義する
    Dim myBar(1) As String
    
    Dim myString() As String
    Dim i As Integer
    
    '前処理
    'コマンドバーの名称設定
    myCbarName = "ToolBar"
    
    'ボタンの数だけ設定する
    '[0]表示
    '[1]ヒント
    '[2]マクロ名
    '[3]FaceID
    '[4]グループ開始
    '[5]表示スタイル／1=アイコン、2=テキスト、3=両方
    myBar(1) = "読み取り専用の設定/解除,読み取り専用の設定/解除,ReadOnlySwitch,456,false,3"
    
    '保存先の指定
    Application.CustomizationContext = ThisDocument
    
    'myCbarNameと同名のコマンドバーがあれば削除
    For Each myToolBar In Application.CommandBars
        If myToolBar.Name = myCbarName Then
            myToolBar.Delete
            Exit For
        End If
    Next
    
    'コマンドバーの作成
    Set myToolBar = CommandBars.Add(Name:=myCbarName, Position:=msoBarTop, Temporary:=False)
    myToolBar.Visible = True
    
    'ボタンの作成
    For i = UBound(myBar) To 1 Step -1
        myString() = Split(myBar(i), ",")
        
        'ボタン追加
        Set myCbarCtl = CommandBars(myCbarName).Controls.Add(Type:=msoControlButton, Temporary:=False, Before:=1)
        
        With myCbarCtl
            'ラベル設定（表示）
            .Caption = myString(0)
            
            'ヒント設定（ヒント）
            .TooltipText = myString(1)
            
            'アクション設定（マクロ名）
            .OnAction = myString(2)
            
            'faceID設定（faceID）
            .FaceId = myString(3)
            
            'グループ開始の設定（グループ開始）
            .BeginGroup = myString(4)
            
            '表示設定（表示スタイル）
            .Style = myString(5)
        End With
        
        Set myCbarCtl = Nothing
    Next
    
    '後処理
    Set myToolBar = Nothing
End Sub