Last Updated 2 Feb 2022
Section Links (this page):
Navigation Pane
Ribbon
Taskbar
Application Window
Example App
This article shows how to manage parts of the application interface using VBA.
Place the code in standard modules
Navigation Pane - hide / mimimise / maximise
Return To Top
CODE:
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modNavPane
' Date : 23/07/2017
' Authors : Various
' Website : https://www.isladogs.co.uk
' Purpose : Functions used to manage the navigation pane
' Copyright : The code in the utility MAY be altered and reused in your own applications
' Updated : October 2017.
'---------------------------------------------------------------------------------------
Public Function ShowNavigationPane()
On Error GoTo ErrHandler
DoCmd.SelectObject acTable, , True
Exit_ErrHandler:
Exit Function
ErrHandler:
MsgBox "Error " & Err.Number & " in ShowNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
Resume Exit_ErrHandler
End Function
'---------------------------------------------------------------------------------------
Public Function HideNavigationPane()
On Error GoTo ErrHandler
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.RunCommand acCmdWindowHide
Exit_ErrHandler:
Exit Function
ErrHandler:
MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
Resume Exit_ErrHandler
End Function
'---------------------------------------------------------------------------------------
Public Function MinimizeNavigationPane()
On Error GoTo ErrHandler
DoCmd.NavigateTo "acNavigationCategoryObjectType"
DoCmd.Minimize
Exit_ErrHandler:
Exit Function
ErrHandler:
MsgBox "Error " & Err.Number & " in HideNavigationPane routine : " & Err.Description, vbOKOnly + vbCritical
Resume Exit_ErrHandler
End Function
Ribbon - hide / minimise / maximise
Return To Top
CODE:
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modRibbon
' Date : 23/07/2017
' Authors : Various
' Website : https://isladogs.co.uk
' Purpose : Functions used to manage the ribbon
' Copyright : The code in the utility MAY be altered and reused in your own applications
' Updated : October 2017.
'---------------------------------------------------------------------------------------
Public Function HideRibbon()
'could run at startup using Autoexec
'however this also hides the QAT which makes printing reports tricky
DoCmd.ShowToolbar "Ribbon", acToolbarNo
' DoCmd.ShowToolbar "PrintReport", acToolbarYes
End Function
'---------------------------------------------------------------------------------------
Public Function ShowRibbon()
'use when opening a report to display print preview ribbon
DoCmd.ShowToolbar "Ribbon", acToolbarYes
End Function
'---------------------------------------------------------------------------------------
Public Function ToggleRibbonState()
If GetAccessVersion > 12 Then
'hide ribbon if visible & vice versa
'doesn't work in Access 2007 (Access 12.0)
CommandBars.ExecuteMso "MinimizeRibbon"
End If
End Function
'---------------------------------------------------------------------------------------
Public Function IsRibbonMinimized() As Boolean
'Result: 0=normal (maximized), -1=autohide (minimized)
IsRibbonMinimized = (CommandBars("Ribbon").Controls(1).Height < 100)
' Debug.Print IsRibbonMinimized
End Function
'---------------------------------------------------------------------------------------
Function GetAccessVersion() As String
'Gets Access version e.g. 12 for Access 2007, 14 for Access 2010 etc
GetAccessVersion = Nz(CInt(SysCmd(acSysCmdAccessVer)), "None")
'Debug.Print GetAccessVersion
End Function
Taskbar - hide / show
Return To Top
CODE:
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modTaskbar
' Date : 23/07/2017
' Authors : Various
' Website : https://isladogs.co.uk
' Purpose : Functions used to manage the taskbar & navigation pane
' Copyright : The code in the utility MAY be altered and reused in your own applications
' Updated : October 2017.
'---------------------------------------------------------------------------------------
#If VBA7 Then
Dim handleW1 As LongPtr
#Else
Dim handleW1 As Long
#End If
'########## API declarations ################
#If VBA7 Then 'Access 2010 or later (32/64-bit)
Private Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" _
(ByVal handleW1 As LongPtr, ByVal handleW1InsertWhere As LongPtr, ByVal w As Long, _
ByVal X As Long, ByVal Y As Long, ByVal Z As Long, ByVal wFlags As Long) As Long
#Else 'A2007 or earlier (32-bit)
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" _
(ByVal handleW1 As Long, ByVal handleW1InsertWhere As Long, ByVal w As Long, _
ByVal X As Long, ByVal Y As Long, ByVal z As Long, ByVal wFlags As Long) As Long
#End If
'###############################################
Const TOGGLE_HIDEWINDOW = &H80
Const TOGGLE_UNHIDEWINDOW = &H40
'---------------------------------------------------------------------------------------
Function HideTaskbar()
handleW1 = FindWindowA("Shell_traywnd", "")
Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW)
End Function
'---------------------------------------------------------------------------------------
Function ShowTaskbar()
Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)
End Function
Application Window - hide / show
Return To Top
CODE:
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modDatabaseWindow
' Date : 23/07/2017
' Authors : Various
' Website : https://isladogs.co.uk
' Purpose : Functions used to manage the application window
' Copyright : The code in the utility MAY be altered and reused in your own applications
' Updated : October 2017.
'---------------------------------------------------------------------------------------
'################# API declarations ##############################
#If VBA7 Then 'Access 2010 or later (32/64-bit)<
Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As LongPtr, lpRect As typRect) As Long
Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As LongPtr, lpRect As typRect) As Long
Private Declare PtrSafe Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
#Else 'A2007 or earlier (32-bit)
Private Declare Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As Long, lpRect As typRect) As Long
Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As typRect) As Long
Private Declare Function apiSetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
'###############################################
'Type declarations:
Private Type typRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'Constant declarations:
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Private Const SW_RESTORE = 9
Private Const SWP_NOSIZE = &H1 ' Don't alter the size
Private Const SWP_NOZORDER = &H4 ' Don't change the Z-order
Private Const SWP_SHOWWINDOW = &H40 ' Display the window
'---------------------------------------------------------------------------------------
Function SetAccessWindow(nCmdShow As Long)
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed, except as part of an application.
' You are free to use it in any application, provided the copyright notice is left unchanged.
'Usage Examples
'Maximize window:
' ?SetAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
' ?SetAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
' ?SetAccessWindow(SW_HIDE)
'Normal window:
' ?SetAccessWindow(SW_SHOWNORMAL)
Dim loX As Long
' Dim loForm As Form
On Error Resume Next
loX = apiShowWindow(hWndAccessApp, nCmdShow)
SetAccessWindow = (loX <> 0)
End Function
'---------------------------------------------------------------------------------------
Function MinimizeApplicationWindow()
'removes application window leaving a taskbar icon
'Use with a popup form so it is left 'floating on the desktop'
SetAccessWindow (SW_SHOWMINIMIZED)
End Function
'---------------------------------------------------------------------------------------
Function RestoreNormalWindow()
SetAccessWindow (SW_SHOWNORMAL)
End Function
Example Application
Return To Top
An example application is available elsewhere on this website which includes all the above code
See Control the Application Interface
Colin Riddington Mendip Data Systems Last Updated 2 Feb 2022