קוד ל 64 ו 32 ביט כולל התניה
Option Compare Database
'התניה ל64 ביט
#If VBA7 Then
'אם 64 ביט, הוספת המילה PtrSafe
Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#Else
'ל32 ביט
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As _
Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#End If
Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&
'
Public Function SetEnabledState(blnState As Boolean)
Call CloseButtonState(blnState)
Call ExitMenuState(blnState)
End Function
'Disable the Menu Option
Sub ExitMenuState(blnExitState As Boolean)
' Application.CommandBars("File").Controls("Exit").Enabled = blnExitState
End Sub
'Disable the Close Button Option
Sub CloseButtonState(boolClose As Boolean)
Dim hWnd As Long
Dim wFlags As Long
Dim hMenu As Long
Dim result As Long
hWnd = Application.hWndAccessApp
hMenu = GetSystemMenu(hWnd, 0)
If Not boolClose Then
wFlags = MF_BYCOMMAND Or MF_GRAYED
Else
wFlags = MF_BYCOMMAND And Not MF_GRAYED
End If
result = EnableMenuItem(hMenu, SC_CLOSE, wFlags)
End Subוינברג
פורסם במקור בפורום CODE613 ב07/11/2015 22:59 (+02:00)
