Access Close Button -Kruisje om Access 64 bit programma te sluiten via VBA code

J

JohanRVT

Gebruiker
Lid geworden
2 mrt 2011
Berichten
545
In de oudere 32 bit versies van Access werkte er een VBA functie prima, via aanroepen van wat API's uit de bibliotheek, om het Access Kruisje rechtsboven uit te schakelen zodat een gebruiker de DB niet vroegtijdig kon sluiten. De functie werd aangeroepen door een "Call AccessCloseButtonEnabled(True)" en bij sluiten van de DB via de daarvoor bestemde knop werd die aanroeping dan "Call AccessCloseButtonEnabled(False)". Nu is mijn vraag wat dat moet worden om te kunnen werken in Access 64 bit versie? De PtrSafe toevoeging is geen oplossing aangezien we nu werken met de Windows 64 bit op 't werk.
Even de oude functie zelf hieronder:
Code: 
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal wRevert As Long) As Long
Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Sub AccessCloseButtonEnabled(pfEnabled As Boolean)
  ' Comments: Control the Access close button.
  '           Disabling it forces the user to exit within the application
  ' Params  : pfEnabled       TRUE enables the close button, FALSE disabled it
  On Error Resume Next

  Const clngMF_ByCommand As Long = &H0&
  Const clngMF_Grayed As Long = &H1&
  Const clngSC_Close As Long = &HF060&
  Dim lngWindow As Long
  Dim lngMenu As Long
  Dim lngFlags As Long

  lngWindow = Application.hWndAccessApp
  lngMenu = GetSystemMenu(lngWindow, 0)
  If pfEnabled Then
    lngFlags = clngMF_ByCommand And Not clngMF_Grayed
  Else
    lngFlags = clngMF_ByCommand Or clngMF_Grayed
  End If
  Call EnableMenuItem(lngMenu, clngSC_Close, lngFlags)
End Sub
 
Deze versie werkt.

Code: 
Option Compare Database
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal bRevert As Long) As LongPtr
    Private Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#Else
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal wRevert 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

Code: 
Public Function AccessCloseButtonEnabled(pfEnabled As Boolean) As Boolean
' Comments: Control the Access close button.
'           Disabling it forces the user to exit within the application
' Params  : pfEnabled       TRUE enables the close button, FALSE disabled it
' Owner   : Copyright (c) 2008-2011 from FMS, Inc.
' Source  : Total Visual SourceBook
' Usage   : Permission granted to subscribers of the FMS Newsletter

On Error Resume Next
Const clngMF_ByCommand As Long = &H0&
Const clngMF_Grayed As Long = &H1&
Const clngSC_Close As Long = &HF060&
Dim lngFlags As Long
#If Win64 Then
    Dim lngWindow As LongPtr
    Dim lngMenu As LongPtr
#Else
    Dim lngWindow As Long
    Dim lngMenu As Long
#End If
  
    lngWindow = Application.hWndAccessApp
    lngMenu = GetSystemMenu(lngWindow, 0)
    If pfEnabled Then
        lngFlags = clngMF_ByCommand And Not clngMF_Grayed
    Else
        lngFlags = clngMF_ByCommand Or clngMF_Grayed
    End If
    Call EnableMenuItem(lngMenu, clngSC_Close, lngFlags)
    AccessCloseButtonEnabled = True
End Function

Volgens mij ongeveer dezelfde code die jij gebruikt, maar met een check op 64 bits. En de correcte variabelen types.
 
GetSystemMenu kent de PC op 't werk hier niet. (Windows 10 Enterprise 64 bit besturingssysteem met 64 bit processor)
 
Wijzig de Declare opdrachten in Declare PtrSafe:
learn.microsoft.com

PtrSafe keyword (VBA)

Office VBA reference topic
learn.microsoft.com
 
Da's vreemd, want ik werk met dezelfde Windows versie.
Code: 
Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan