Office ボタンのクリックを禁止する

今回はOffice ボタンのクリックを禁止する方法を紹介します。
フック処理を行いますので、実行は自己責任でお願い致します。
※ moug にて、熊谷隆史さんから誤ったコード部分をご指摘いただき修正しました。この場を借りてお礼申し上げます。

[標準モジュール]
※ コードのレイアウトが崩れて表示される場合は、ページのフォントサイズを小さくして閲覧してください。


                    Option Explicit

                    

                    Private Declare Function AccessibleObjectFromEvent Lib "oleacc" (ByVal hWnd As Long, ByVal dwObjectID As Long, ByVal dwChildID As Long, ppacc As Office.IAccessible, pvarChild As Variant) As Long

                    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

                    Private Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal lpfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwflags As Long) As Long

                    Private Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long

                    

                    Private Const CHILDID_SELF = 0&

                    Private Const EVENT_SYSTEM_MENUPOPUPSTART = &H6

                    Private Const WINEVENT_OUTOFCONTEXT = &H0

                    Private Const ROLE_SYSTEM_BUTTONDROPDOWNGRID = &H3A  'Microsoft Office ボタン

                    

                    Private hEventHook As Long

                    

                    Public Sub StartEventHook()

                    'フック開始

                      If hEventHook <> 0& Then Exit Sub

                      hEventHook = SetWinEventHook(EVENT_SYSTEM_MENUPOPUPSTART, EVENT_SYSTEM_MENUPOPUPSTART, 0&, AddressOf WinEventProc, 0&, GetCurrentThreadId(), WINEVENT_OUTOFCONTEXT)

                      Debug.Print "--- フック開始 --- (" & Hex(hEventHook) & ")"

                    End Sub

                    

                    Public Sub EndEventHook()

                    'フック終了   ※ 必ず実行

                      If hEventHook = 0& Then Exit Sub

                      Call UnhookWinEvent(hEventHook)

                      hEventHook = 0&

                      Debug.Print "--- フック終了 ---"

                    End Sub

                    

                    Public Sub WinEventProc(ByVal hWinEventHook As Long, ByVal levent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal dwEventThread As Long, ByVal dwmsEventTime As Long)

                      Dim myAcc As Office.IAccessible

                      Dim accOfficeButton As Office.IAccessible

                      Dim v As Variant

                      

                      If AccessibleObjectFromEvent(hWnd, idObject, idChild, myAcc, v) = 0& Then

                        On Error Resume Next

                        If (myAcc.accParent.accName(CHILDID_SELF) = "Office ボタン") And _

                           (myAcc.accParent.accRole(CHILDID_SELF) = ROLE_SYSTEM_BUTTONDROPDOWNGRID) Then

                          Set accOfficeButton = myAcc.accParent

                          accOfficeButton.accDoDefaultAction (CHILDID_SELF)

                          MsgBox "Office ボタンのクリックは禁止です。", vbCritical, "警告"

                          Set accOfficeButton = Nothing

                        End If

                        On Error GoTo 0

                      End If

                    End Sub

上記コードを標準モジュールに貼り付け「StartEventHook」を呼び出すと、Office ボタンをクリックしたときに警告が表示され、Office メニューが表示されなくなります。
終了させる際は必ず「EndEventHook」を実行してフック処理を終わらせてからファイルを閉じるようにしてください。

※ 上記コードをAccessで実行する際は、事前にコード中の「Office.IAccessible」となっている部分を「IAccessible」に変更し、「system32」フォルダ内の「oleacc.dll」ファイルを参照してください。
※ 上記コードはOfficeのバージョン変更等に伴って、正常に動作しなくなる可能性があります。

トップページ > リボン関連 > Office ボタンのクリックを禁止する