Soyez le premier à donner votre avis sur cette source.
Vue 16 380 fois - Téléchargée 971 fois
'******************************************************************************************** '* ApiWindows : Déclaration des API Windows * '******************************************************************************************** Option Compare Database Option Explicit ' GetDesktopWindow : Donne le pointeur de la fenêtre du bureau Public Declare Function GetDesktopWindow Lib "user32" ( _ ) As Long ' GetParent : Donne le pointeur de la fenêtre parent Public Declare Function GetParent Lib "user32" _ (ByVal hwnd As Long _ ) As Long ' GetWindow : Donne le pointeur d'une fenêtre Public Declare Function GetWindow Lib "user32" _ (ByVal hwnd As Long _ , ByVal wCmd As Long _ ) As Long Public Const GW_HWNDFIRST = 0 ' Pointeur de la première fenêtre Public Const GW_HWNDNext = 2 ' Pointeur de la fenêtre suivante ' GetWindowRect : Donne le rectangle d'affichage de la fenêtre Public Declare Function GetWindowRect Lib "user32" _ (ByVal hwnd As Long _ , lpRect As RECT _ ) As Long Public Type RECT ' Rectangle d'affichage de la fenêtre left As Long top As Long right As Long bottom As Long End Type ' MoveWindow : Positionne et dimensionne la fenêtre Public Declare Function MoveWindow Lib "user32" _ (ByVal hwnd As Long _ , ByVal x As Long _ , ByVal y As Long _ , ByVal nWidth As Long _ , ByVal nHeight As Long _ , ByVal bRepaint As Long _ ) As Long ' ShowWindow : Défini le mode d'affichage de la fenêtre Public Declare Function ShowWindow Lib "user32" _ (ByVal hwnd As Long _ , ByVal nCmdShow As Long _ ) As Long '******************************************************************************************** '* CommonFunctions : Fonctions communes du projet * '******************************************************************************************** Option Compare Database Option Explicit '===== HideApplicationForm : Cacher la fenêtre application ================================== Function HideApplicationForm(FormId As Form) On Error GoTo Err_HideApplicationForm Dim hwndApplication As Long ' Fenêtre de l'application Dim lRect As RECT ' Dimension du bureau Dim wWidth As Long ' Largeur du formulaire Dim wHeight As Long ' Hauteur du formulaire ' Stocker le pointeur de le fenêtre principale '--------------------------------------------- Application.Echo False hwndApplication = GetParent(GetParent(GetWindow(FormId.hwnd, GW_HWNDFIRST))) ' Maximiser la fenêtre principale '-------------------------------- ShowWindow hwndApplication, 3 ' Restore du formulaire '----------------------- DoCmd.Restore ' Stocker les dimensions du formulaire '------------------------------------- wWidth = FormId.WindowWidth wHeight = FormId.WindowHeight ' Cacher puis restorer la fenêtre principale '------------------------------------------- ShowWindow hwndApplication, 0 ShowWindow hwndApplication, 1 ' Stocker les dimensions du bureau '--------------------------------- GetWindowRect GetDesktopWindow, lRect ' Dimensionner et centrer la fenêtre principale '---------------------------------------------- If CurrentDb.Properties("StartUpShowStatusBar") = False Then MoveWindow hwndApplication _ , (lRect.right - (wWidth / 15)) / 2 _ , (lRect.bottom - (wHeight / 15)) / 2 _ , wWidth / 15, wHeight / 15 _ , 1 Else MoveWindow hwndApplication _ , (lRect.right - (wWidth / 15)) / 2 _ , (lRect.bottom - (wHeight / 15)) / 2 _ , (wWidth / 15), 20 + (wHeight / 15) _ , 1 End If ' Maximiser le formulaire '------------------------ DoCmd.Maximize ' Sortie et Gestion des Erreurs '------------------------------ Exit_HideApplicationForm: Application.Echo True Exit Function Err_HideApplicationForm: Select Case Err.Number Case Else MsgBox Err.Number & " " & "CommonFunctions" & " " _ & "HideApplicationForm" & " :" & vbLf _ & Nz(Err.Description, "") & vbLf _ & "Values : " & FormId.Name End Select Resume Exit_HideApplicationForm End Function '===== ShowApplicationForm : Rétablir la fenêtre application ================================= Function ShowApplicationForm(FormId As Form) On Error GoTo Err_ShowApplicationForm Dim hwndApplication As Long ' Fenêtre de l'application ' Stocker le pointeur de le fenêtre principale '--------------------------------------------- Application.Echo False hwndApplication = GetParent(GetParent(GetWindow(FormId.hwnd, GW_HWNDFIRST))) ' Cacher, afficher puis maximiser la fenêtre principale '------------------------------------------------------ ShowWindow hwndApplication, 0 ShowWindow hwndApplication, 1 ShowWindow hwndApplication, 3 ' Restore du formulaire '----------------------- DoCmd.Restore ' Sortie et Gestion des Erreurs '------------------------------ Exit_ShowApplicationForm: Application.Echo True Exit Function Err_ShowApplicationForm: Select Case Err.Number Case Else MsgBox Err.Number & " " & "CommonFunctions" & " " _ & "ShowApplicationForm" & " :" & vbLf _ & Nz(Err.Description, "") & vbLf _ & "Values : " & FormId.Name End Select Resume Exit_ShowApplicationForm End Function '===== Form_Open : Ouverture du formulaire ================================================== Private Sub Form_Open(Cancel As Integer) On Error GoTo Err_Form_Open ' Cacher la fenêtre de l'application '----------------------------------- HideApplicationForm Me.Form Exit_Form_Open: Exit Sub Err_Form_Open: Select Case Err.Number Case Else MsgBox "Form_Open : Erreur n° " & Err.Number & " > " & Err.Description End Select Resume Exit_Form_Open End Sub '===== Form_KeyDown : Touche appuyée ======================================================== Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) On Error GoTo Err_Form_KeyDown ' CTRL A : Restorer la fenêtre de l'application '---------------------------------------------- If KeyCode = vbKeyA And (Shift And acCtrlMask) > 0 Then ShowApplicationForm Me.Form KeyCode = 0 GoTo Exit_Form_KeyDown End If Exit_Form_KeyDown: Exit Sub Err_Form_KeyDown: Select Case Err.Number Case Else MsgBox "Form_KeyDown : Erreur n° " & Err.Number & " > " & Err.Description End Select Resume Exit_Form_KeyDown End Sub
C'est une bidouille, c'est pas beau pour du MS Access, et ça n'utilise AUCUNE ERREUR DE CHEZ MICROSOFT !
Juste histoire d'être clair ;)
Par contre, c'est cool que tu ai codé cette fonctionnalité, ça me fait gagné bien du temp ^^
Ce que je voulais c'était d'enlever totalement la barre d'access mais comment faire?
on peut également remplacer
hwndApplication = GetParent(GetParent(GetWindow(FormId.hwnd, GW_HWNDFIRST)))
par
hwndApplication =application.hWndAccessApp
ce qui permet de s'affranchir de l'api getparent
If CurrentDb.Properties("StartUpShowStatusBar") = False Then
si la propriété "afficher barre d'état" n'a jamais été définie dans outils/démarrage, ça plante. il faut rajouter les 3 lignes de codes ci dessous juste avant le if :
Set Prp = CurrentDb.CreateProperty("StartUpShowStatusBar", dbBoolean, False)
CurrentDb.Properties.Append Prp
CurrentDb.Properties("StartUpShowStatusBar") = False
(source http://www.info-3000.com/access/daosaufrecordsets.htm)
sinon ça tourne nickel :)
Je fais pareil sous Excel avec simplement :
ActiveWorkbook.Parent.Visible = False
qui doit fonctionner sous Access avec un truc du genre :
ActiveForm.Parent.Visible = False
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.