Remove ribbon but keep QAT in Access using VBA - ms-access

Question

I've successfully removed the ribbon on startup by using this line of code:
DoCmd.ShowToolbar "Ribbon", acToolbarNo
But this also removes the Quick Access Toolbar. I want this to stay so that the user can only see the icons I've selected to be shown (Copy, Paste, Export to Excel, etc,.)
My ultimate goal is to have only these icons appear, and the header to be otherwise empty, thin and out of the way. I'm trying to save as much screen space as possible, and I do not want the user to have to ability to expand the ribobn.
Is there a similar line of code that will force the QAT to be shown. Furthermore, is there a way to select which shortcuts will appear in the QAT with VBA. I know this can be done manually, but I'm trying to automate it.

Answer 1

Looks like it's possible using custom Access XML
Start by going and reading through this
https://support.office.com/en-us/article/Customize-the-Ribbon-45e110b9-531c-46ed-ab3a-4e25bc9413de
and then you'll need to create your own bit of XML code to control everything
here a list of the control idMso to use http://www.ribboncreator2010.de/Onlinehelp/EN/_2el0osmon.htm
the following is a something i whipped together as a proof of concept
<?xml version="1.0" encoding="UTF-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="true">
<tabs>
<tab idMso="TabAddIns">
</tab>
</tabs>
<qat>
<documentControls>
<control idMso="SaveObjectAs" />
</documentControls>
</qat>
</ribbon>
</customUI>
this is what is looks like

Answer 2

Not sure how helpful is replying to 5 years old thread, but who knows...
Few days ago I had to (finally) move from Access 2010 to 2021 and was stunned with new UI in general, but mostly with how much space is wasted at the top, especially for my usual scenario for distributed apps - QAT without ribbons and everything else on the right mouse. I didn't take it very seriously at first, believing I'm not the only one with such layout and ready-made solution(s) would be there, in numbers. That was a second surprise, because there are none. "Blank" ribbon is still wasting 40-50px of space with File ribbon not removable. Aside from ruining the concept, everybody will ask "Why is this blank File menu there doing nothing...??"
This is not very difficult to solve, but (like everybody else) I prefer copy/paste to writing own solution from scratch, sadly it was not there to grab :) So here's simple solution for those who want their ~40px back :)
It is assumed you handle all the usual stuff like hiding navigation bar, prevent F11, opening with Shift, hiding Taskbar etc. Or not. It will work even in "design" mode scenarios, but it's not meant for that. For now I simply hardcoded 45px for Window bar/QAT height, can be modified, calculated, but can't be bothered at the moment. Also, this will not work with Access 2010 and earlier, can be made to work if somebody wants to play with it, I'll not
Here's code
Somewhere in your start up routine add these 2 lines of code
moveMDIUp
SubClass_On Access.hWndAccessApp
Create new Code module and insert this code:
'######################################################################
'Module to show only QAT and hide the ribbon
'Miroslav, June 2022
'######################################################################
Option Compare Database
Option Explicit
'Set height of window/QAT bar you wish to keep/see
Private Const QAT_Height = 45
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As LongPtr, ByVal hWndChildAfter As LongPtr, ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As LongPtr
Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As LongPtr
Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, 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 LongPtr
Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal wNewWord As LongPtr) As LongPtr
Private Const GWL_WNDPROC = (-4)
Private Const WM_WINDOWPOSCHANGED = &H47
Private Const WM_SYSCOMMAND = &H112
Private m_PrevProc As LongPtr
Private m_PrevProcSH As LongPtr
Private SHDhwnd As LongPtr
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Sub moveMDIUp()
Dim MDIhwnd, ACChwnd, TASKhwnd, NAVhwnd, RIBhwnd, s
Dim navWidth As Long: Dim taskHeight As Long: Dim ribHeight As Long: Dim accWidth As Long: Dim accHeight As Long: Dim mRECT As RECT
ACChwnd = Application.hWndAccessApp
MDIhwnd = FindWindowEx(ACChwnd, 0, "MDIClient", vbNullString)
SHDhwnd = FindWindowEx(ACChwnd, 0, "DropShadow", vbNullString)
'Hide shadow below the ribbon
ShowWindow SHDhwnd, 0
'Get Access width and height
GetWindowRect ACChwnd, mRECT
accHeight = mRECT.Bottom - mRECT.Top
accWidth = mRECT.Right - mRECT.Left
'Find height of taskbar, if not shown it's 0 height
TASKhwnd = FindWindowEx(ACChwnd, 0, "MsoCommandBarDock", "MsoDockBottom")
TASKhwnd = FindWindowEx(TASKhwnd, 0, "MsoCommandBar", "Status Bar")
GetWindowRect TASKhwnd, mRECT
taskHeight = mRECT.Bottom - mRECT.Top
s = SetWindowPos(MDIhwnd, 0, 0, QAT_Height, accWidth - 2, accHeight - QAT_Height - taskHeight - 1, 0)
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProc = CallWindowProc(m_PrevProc, hwnd, uMsg, wParam, lParam)
If (uMsg = WM_SYSCOMMAND) And (wParam = 61536) Then
'unhook here...
Call SubClass_Off(Application.hWndAccessApp)
Call SubClassSH_Off(SHDhwnd)
Exit Function
End If
End Function
Public Function SubClass_On(ByVal hwnd As Long)
m_PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
Call SubClassSH_On(SHDhwnd)
End Function
Public Function SubClass_Off(ByVal hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, m_PrevProc
End Function
Public Function WindowProcSH(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
WindowProcSH = CallWindowProc(m_PrevProcSH, hwnd, uMsg, wParam, lParam)
If uMsg = WM_WINDOWPOSCHANGED Then
moveMDIUp
End If
End Function
Public Function SubClassSH_On(ByVal hwnd As Long)
m_PrevProcSH = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProcSH)
End Function
Public Function SubClassSH_Off(ByVal hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, m_PrevProcSH
End Function