Mendip Data Systems
Database applications for businesses and schools
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modNavPane
' DateTime : 23/07/2017
' Authors : Various
' Website : http://www.mendipdatasystems.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
Code Samples for Businesses, Schools & Personal Use
This article shows how to manage parts of the application interface using VBA.
Place the code in standard modules
a) Navigation Pane - hide / mimimise / maximise
Manage Navigation Pane / Ribbon / Taskbar / Application Window
b) Ribbon - hide / minimise / maximise
Code:
c) Taskbar - hide / show
Code:
Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Module : modRibbon
' DateTime : 23/07/2017
' Authors : Various
' Website : http://www.mendipdatasystems.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
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. 14 for Access 2010
GetAccessVersion = Nz(CInt(SysCmd(acSysCmdAccessVer)), "None")
'Debug.Print GetAccessVersion
End Function
Option Compare Database
Option Explicit
Dim handleW1 As Long
'###############################################
#If VBA7 Then 'add PtrSafe
Private Declare PtrSafe Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe 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
#ElseIf Win64 Then 'need datatype LongPtr
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 LongPtr, _
ByVal X As LongPtr, ByVal Y As LongPtr, ByVal z As LongPtr, _
ByVal wFlags As LongPtr) As LongPtr
#Else '32-bit Office
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
'---------------------------------------------------------------------------------------
' Module : modTaskbar
' DateTime : 23/07/2017
' Authors : Various
' Website : http://www.mendipdatasystems.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.
'---------------------------------------------------------------------------------------
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
d) Application Window - hide / show
Code:
Option Compare Database
Option Explicit
' API declarations
'###############################################
#If VBA7 Then
Private Declare PtrSafe Function apiGetClientRect Lib "user32" Alias "GetClientRect" (ByVal hWnd As Long, lpRect As typRect) As Long
Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As typRect) As Long
Private Declare PtrSafe 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 PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#ElseIf Win64 Then 'need datatype LongPtr
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 '32-bit Office
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
'---------------------------------------------------------------------------------------
' Module : modDatabaseWindow
' DateTime : 23/07/2017
' Authors : Various
' Website : http://www.mendipdatasystems.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.
'---------------------------------------------------------------------------------------
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 lefty 'floating on the desktop
SetAccessWindow (SW_SHOWMINIMIZED)
End Function
Function RestoreNormalWindow()
SetAccessWindow (SW_SHOWNORMAL)
End Function
NOTE:
An example application is available which includes all the above code