Afsluiten Database
- Onderwerp starter Daneron
- Startdatum
- Status
. Voor alle zekerheid maak je eerst een kopie van uw database zodat je eens kunt testen.
Je maakt eerst een nieuwe klassemodule met de naam "CloseCommand" en zet daar het volgende in
Option Compare Database
Option Explicit
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
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As _
Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&
Public Property Get Enabled() As Boolean
Dim hWnd As Long
Dim hMenu As Long
Dim result As Long
Dim MI As MENUITEMINFO
MI.cbSize = Len(MI)
MI.dwTypeData = String(80, 0)
MI.cch = Len(MI.dwTypeData)
MI.fMask = MF_GRAYED
MI.wID = SC_CLOSE
hWnd = Application.hWndAccessApp
hMenu = GetSystemMenu(hWnd, 0)
result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
Enabled = (MI.fState And MF_GRAYED) = 0
End Property
Public Property Let Enabled(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 Property
Daarna maak je een gewone nieuwe module (bv Module1) met het volgende erin:
Function InitApplication()
Application.SetOption "ShowWindowsInTaskbar", False
Dim c As CloseCommand
Set c = New CloseCommand
'Disable Close menu.
c.Enabled = False
End Function
Daarna maak je een macro met de naam "Autoexec".
De commando's die je in deze macro zet worden dan altijd uitgevoerd bij het opstarten van uw database. In de kolom actie kies je "ProcedureUitvoeren". Onderaan links vraagt men dan de functienaam en daar zet je:
InitApplication()
Je moet dan ook zorgen dat je op uw openingsformulier een aparte knop zet die uw database sluit.
Veel succes
Je maakt eerst een nieuwe klassemodule met de naam "CloseCommand" en zet daar het volgende in
Option Compare Database
Option Explicit
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
Private Declare Function GetMenuItemInfo Lib "user32" Alias _
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, ByVal b As _
Long, lpMenuItemInfo As MENUITEMINFO) As Long
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type
Const MF_GRAYED = &H1&
Const MF_BYCOMMAND = &H0&
Const SC_CLOSE = &HF060&
Public Property Get Enabled() As Boolean
Dim hWnd As Long
Dim hMenu As Long
Dim result As Long
Dim MI As MENUITEMINFO
MI.cbSize = Len(MI)
MI.dwTypeData = String(80, 0)
MI.cch = Len(MI.dwTypeData)
MI.fMask = MF_GRAYED
MI.wID = SC_CLOSE
hWnd = Application.hWndAccessApp
hMenu = GetSystemMenu(hWnd, 0)
result = GetMenuItemInfo(hMenu, MI.wID, 0, MI)
Enabled = (MI.fState And MF_GRAYED) = 0
End Property
Public Property Let Enabled(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 Property
Daarna maak je een gewone nieuwe module (bv Module1) met het volgende erin:
Function InitApplication()
Application.SetOption "ShowWindowsInTaskbar", False
Dim c As CloseCommand
Set c = New CloseCommand
'Disable Close menu.
c.Enabled = False
End Function
Daarna maak je een macro met de naam "Autoexec".
De commando's die je in deze macro zet worden dan altijd uitgevoerd bij het opstarten van uw database. In de kolom actie kies je "ProcedureUitvoeren". Onderaan links vraagt men dan de functienaam en daar zet je:
InitApplication()
Je moet dan ook zorgen dat je op uw openingsformulier een aparte knop zet die uw database sluit.
Veel succes
Gebruikers kunnen een toepassing altijd sluiten taakbeheer (de dialoog die opkomt als CTRL+ALT+DEL indrukt).
Het verwijderen van het 'afsluitkruisje' is dus geen garantie dat gebruikers je toepassing niet op de een of andere manier sluiten.
Waarom wil je het 'afsluitkruisje' weghebben?
Misschien is er een andere manier om je probleem op te lossen.
Het verwijderen van het 'afsluitkruisje' is dus geen garantie dat gebruikers je toepassing niet op de een of andere manier sluiten.
Waarom wil je het 'afsluitkruisje' weghebben?
Misschien is er een andere manier om je probleem op te lossen.
Bij het testen door de eindgebruikers kwam naar voren dat sommige niet wisten hoe ze terug konden naar het hoofdmenu. Om nu de hele database structuur weer aan te passen om een nog duidelijke sluitknop te plaatsen (die overigens duidelijk genoeg wordt weergeven) wil ik als laatste optie open houden.
Scarie, ik zal de code eens uit proberen op een backup en op een andere pc ( je weet maar nooit
)
in ieder geval bedankt.
mvrg
Scarie, ik zal de code eens uit proberen op een backup en op een andere pc ( je weet maar nooit
)in ieder geval bedankt.
mvrg
Sorry dat ik zo laat reageer. Toen ik decode uitprobeerde werkte het niet en zocht naar een alternatief. Het programma bleef zoals het was en bepaalde records werden niet opgeslagen, wederom de code nog maar eens geprobeerd en toen werkte hij wel, schijnbaar iets verkeerds gedaan.
Nog bedankt Scarie
het werkt perfect
Nog bedankt Scarie
het werkt perfect- Status
