Draw Shortcut Keys in Access

Option Compare Database 
Option Explicit 
'*************** Code Start *****************************************************
' code behind report: r_Shortcutz
'     fyi: detail Height set to 0.3 inches (432 twips)
'     -- code could change but currently does not
'        since report would take so much longer to render
'-------------------------------------------------------------------------------
' Purpose  : VBA to use PRINT to write text
'              and LINE to draw boxes
' Author   : crystal (strive4peace), 221024
' Code List: www.msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Draw_Shortcuts.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Use at your own risk.
' NEEDS
'  QUERY: qShortcutz_Report
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           module variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim db As DAO.Database _ 
   ,rs As DAO.Recordset 
   
   'space is area between text and box
Dim mXSpace As Double _ 
   ,mYSpace As Double _ 
   ,mYHeightText As Double _ 
   ,mnColorText As Long _ 
   ,mnColorLine As Long 
   
   'mX1,mY1 is upper-left coordinate
   'mX2, mY2 is lower-right coordinate
   'mXWidth is width of text to draw at that moment
Dim msSQL As String _ 
   ,sText As String _ 
   ,mX1 As Double,mY1 As Double _ 
   ,mX2 As Double,mY2 As Double _ 
   ,mXWidth As Double 
   
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           Report_Close
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Report_Close() 
'221008 s4p release objects
   On Error Resume Next 
   If Not rs Is Nothing Then 
      rs.Close 
      Set rs = Nothing 
   End If 
   Set db = Nothing 
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           ReportHeader_Format
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub ReportHeader_Format(Cancel As Integer,FormatCount As Integer) 
'210808 s4p
   'set the report font/drawing properties
   'note: if you change, also adjust Me.Detail.Height
   '     currently = 0.3 inches = 432 twip
   
   With Me 
      .FontName =  "Arial"
      .FontSize =  "18"
      .FontItalic = False 
      .FontBold = True 
      
      .DrawWidth = 2  'px
      
      ' spacing between things written hozontally
      '  relative to FontSize
      mXSpace = .FontSize * 6 
      'font size is measured in points
      '  Point = 20 twip.
      ' Adjust HeightText to be shorter
      '  so report looks better to you
      '           -- CUSTOMIZE
      '     note: adjust ratio for personal taste
      mYHeightText = .FontSize * 20 * 0.75 
      
      ' Vertical spacing between box and text
      mYSpace = .FontSize 
      
      'although the physical position on the page changes,
      '  the relative position for each detail is constant
      ' set upper Y coordinate for box around text for Key
      mY1 = 48 
      
      'bottom Y coordinate for box
      mY2 = mY1 + mYHeightText + mYSpace 

   End With  'Me
   

   mnColorText = RGB(0,0,0)  'black
   mnColorLine = RGB(100,100,100)  'dark gray
End Sub 
   
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           Detail_Format
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Sub Detail_Format(Cancel As Integer,FormatCount As Integer) 
'210808 s4p, 221008
   Call DrawShortcut(Me,Me.SID)  ', mXleft, mYtop)
End Sub 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'           DrawShortcut
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'use PRINT and LINE to draw shortcut keys
Sub DrawShortcut(pReport As Report _ 
   ,pnSID As Long _ 
   ) 
   
   If db Is Nothing Then 
      'reuse database object
      Set db = CurrentDb 
   End If 
   
   'get data for keys and literals for SID
   msSQL =  "SELECT K.KName, SK.Lit" _ 
      &  " FROM Keyz AS K " _ 
      &  " RIGHT JOIN ShortKey AS SK ON K.KeyID = SK.KeyID" _ 
      &  " WHERE(SK.SID  = " & pnSID &  ")" _ 
      &  " ORDER BY SK.Ordr;"

   'use dbOpenSnapshot so all records loaded first
   Set rs = db.OpenRecordset(msSQL,dbOpenSnapshot) 
   
   'initialize starting X
   mX1 = 72  '221023 s4p 0.05 * 1440
   
   '------------------------------------ Report
   With pReport 
   
      'loop through each record with key and/or literal
      Do While Not rs.EOF 

         '------------------ KEY
         sText = Nz(rs!KName, "") 
         If sText <>  "" Then 
            'width of text to write
            mXWidth = .TextWidth(sText) 
            
            'ending coordinate for box
            'mXSpace defined in Report Header
            'multiply by 2 for space before and after text
            mX2 = mX1 + mXWidth + mXSpace * 2 
            
            'draw box
            'Line (Step (x1, y1) - Step (mX2, mY2), Color, BF)
            pReport.Line (mX1,mY1)-(mX2,mY2),mnColorLine,B 
                        
            '----- text
            'add spacing between box and text
            'to starting positions
            .CurrentX = mX1 + mXSpace 
            .CurrentY = mY1 + mYSpace 
            .ForeColor = mnColorText 

            'write text
            .Print sText 
            
            'set mX1 position for next key or literal
            mX1 = mX2 + mXSpace / 2 

         End If 
      
         '------------------ LITERAL
         sText = Nz(rs!Lit, "") 
         If sText <>  "" Then 
            .CurrentX = mX1  '+ mXSpace / 2
            .CurrentY = mY1 + mYSpace / 2 
            .ForeColor = mnColorText 
            .Print sText 
         
            'set mX1 position for next key or literal
            mX1 = .CurrentX + mXSpace / 2 
          End If 
         'next record
         rs.MoveNext 
      Loop  'rs
   End With  'Me
   
   rs.Close 
   
End Sub 

'*************** Code End *******************************************************