Powerpoint Word (VBA) 読み取り専用で開き直す マクロ

読み取り専用で開き直すマクロを作ってみました。(powerpoint版。便利のためにwordも書いてありますがwordの方はコピペです、すみません。powerpoint版もコピペ＋コピペですが。。。すみません。)

●機能
powerpoint, wordで読み取り専用で開き直すマクロです
2回実行すると読み取り専用が解除されます
※excelはクイックアクセスツールバーに標準機能で装備されているため不要


●用途
仕事等で他の人が編集する可能性のあるファイルを開くとき(NAS等のネットワーク上にファイルがある場合等)


●設定方法
powerpointはアドイン、wordは個人用マクロに登録を行い、クイックアクセスツールバーに追加して使用
※powerpointではword,excelのマクロとは違いアドインに設定する必要がある
個人用マクロの設定とアドインの設定は以下を参照ください
↓個人用マクロ設定方法＆アドイン設定方法↓
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1160241916


●マクロ
【Powerpoint用マクロ】

Sub Auto_Open()
    'マクロを登録※アドインへの表示に必要
    Dim CBC As CommandBarControl
    Set CBC = Application.CommandBars("Tools").Controls.Add(Type:=msoControlButton)
    CBC.Caption = "OpenReadOnly"
    CBC.OnAction = "OpenReadOnly"
End Sub
Sub Auto_Close()
    'マクロの登録解除※アドインへの表示解除に必要
    Dim CBC As CommandBarControl
    For Each CBC In Application.CommandBars("Tools").Controls
        If CBC.Caption = "OpenReadOnly" Then CBC.Delete
    Next
End Sub
'現在のファイルを上書きせずに閉じて読み取り専用で開き直す
Public Sub OpenReadOnly()
    With ActivePresentation
        If Len(.path) = 0 Then
            '未保存のファイルなら処理終了
            Exit Sub
        End If
        Dim path As String: path = .FullName
        Dim isReadOnly As Boolean: isReadOnly = Not .ReadOnly
        '上書きせずに一度閉じる
        .Saved = msoTrue
        Call .Close
    End With

    '開き直して印刷レイアウトで表示
    Call Presentations.Open(FileName:=path, ReadOnly:=isReadOnly)
End Sub

【Word用マクロ】

'現在のファイルを上書きせずに閉じて読み取り専用で開き直す
Public Sub OpenReadOnly()
    With ActiveDocument
        If Len(.path) = 0 Then
            '未保存のファイルなら処理終了
            Exit Sub
        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

●参考文献
【WordVBA】読み取り専用で開き直す：
https://qiita.com/11295/items/7e29f99759e80d2997ba

Powerpointアドイン登録方法：
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1160241916

参考にさせて頂きました。ありがとうございました。