カスタム検索
リボン関連

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のバージョン変更等に伴って、正常に動作しなくなる可能性があります。