Border2D Heading Text ~ LEARN MS-ACCESS TIPS AND TRICKS

Introduction.

MS Access Form and Report design tools are very user-friendly and only require some practice to master. However, manually creating effects like the one shown in the image above can be quite challenging, though it is possible. The effect can be achieved by stacking five identical labels on top of each other: the topmost label should have a red font color, while the four labels beneath it should have a white font. Each of the white labels should be shifted by about one pixel in different directions—top-left, top-right, bottom-left, and bottom-right—relative to the red label to create a 3D or shadowed effect.

The Sample Report Title image is given below:

However, manually positioning all the labels precisely to maintain the intended style, without distortion, is not easy. Fortunately, you can create the red-colored heading text with white-bordered layers—shown above—in just seconds using the user-defined function provided below. The color can be customized as needed. This function automates the technique described earlier, saving you time and effort.

Automating Text Styling

Copy and paste the VBA code below into a new global module in your database. If you've already copied the first three functions (listed below) and the global declarations from the earlier post “Create 3D Headings on Forms”, then you only need to copy and paste the final function Border2D.

The following common functions are used for all 2D/3D styles:

FormTxtLabels()
Validate_Dup()
MsgLabel()

If you have already copied them earlier, then copy only the last Function: Border2D()

Option Compare Database
 Option Explicit
 '-- Global declarations
 Private Const lngheight as long = 0.45 * 1440
 Private Const lngWidth as long = 4.5 * 1440
 Private Const intFontSize as integer = 26
 Private Const intTextAlign as integer = 0
 Private Const intBackStyle as integer = 0
 Private Const LngI as long = 0.0104 * 1440
 Private Const intX as long = 0.15 * 1440
 Private Const intY as long = 0.15 * 1440
 Dim MyFrm As Form 

Public Function FormTxtLabels(Optional ByVal ControlType As Integer) As String 
'---------------------------------------------------
'Author : a.p.r. pillai 
'Date : September 2006
'ControlType = 0 for label
'ControlTYPE = 1 for TextBox 
'--------------------------------------------------- 
Dim ctl As Control 
'On Error GoTo FormTxtLabels_Err
If ControlType > 0 Then ControlType = 1 

Set MyFrm = CreateForm 

If ControlType = 1 Then
   Set ctl = CreateControl(MyFrm.NAME, acTextBox, acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight) 

   With ctl
    .ControlSource = "=" & Chr(34) & "msaccesstips.com" & Chr(34)
   End With
Else
   Set ctl = CreateControl(MyFrm.NAME, acLabel, _acDetail, , , (0.2 * 1440), (0.2 * 1440), lngWidth, lngheight)

  With ctl
    .Caption = "msaccesstips.com" 
  End With

End If 

FormTxtLabels = MyFrm.NAME 

FormTxtLabels_Exit: 
Exit Function 

FormTxtLabels_Err: 
MsgBox Err.Description, , "FormTxtLabels" 
FormTxtLabels = "" 
Resume FormTxtLabels_Exit 
End Function

Public Function Validate_Dup(ByRef MyFrm As Form, ByVal intNooflabels As Integer) As Integer 
'---------------------------------------------------
'Author : a.p.r. pillai 
'Date : September 2006
'ControlType = 0 for label
'ControlTYPE = 1 for TextBox 
'---------------------------------------------------
Dim mysec As Section, lblcount As Integer 
Dim myctrl As Control, newctrl As Control, j As Integer 
Dim lngx As Long, lngY As Long, lngH As Long, lngW As Long 
Dim strCap As String, ctrltype As Integer, intlbls As Integer 
Dim ctrlName() As String, ctrlIndex() As Integer, i As Long
Dim strFont As String, intFntSize As Integer, x As Integer 
Dim intFntWeight As Integer  

'On Error GoTo Validate_Dup_Err 

Set mysec = MyFrm.Section(acDetail)
intlbls = mysec.Controls.Count - 1 

Set myctrl = mysec.Controls(0) 
ctrltype = myctrl.ControlType 
intNooflabels = intNooflabels - 1 
If intlbls > 0 Then 
  ReDim ctrlName(intlbls) As String
  ReDim ctrlIndex(intlbls) As Integer 
End If 
If ctrltype = 109 And intlbls > 0 Then 
    For j = 0 To intlbls 
      Set myctrl = mysec.Controls(j) 
      ctrlIndex(j) = myctrl.ControlType 
      ctrlName(j) = myctrl.NAME 
    Next 
  For j = 0 To intlbls 
    If ctrlIndex(j) = 100 Then 
      DeleteControl MyFrm.NAME, ctrlName(j) 
    End If 
  Next 
  intlbls = mysec.Controls.Count - 1 
End If 

Set myctrl = mysec.Controls(0) 
If intlbls < intNooflabels Then 
With myctrl
  lngx = .Left
  lngY = .Top
  lngW = .Width
  lngH = 0.0208 * 1440 ' 0.0208 inches
  strFont = .FontName
  intFntSize = .FontSize
  intFntWeight = .FontWeight 
End With 

If ctrltype = 100 Then 
  strCap = myctrl.Caption 
ElseIf ctrltype = 109 Then 
  strCap = myctrl.ControlSource 
End If 
If ctrltype = 109 And intlbls > 0 Then 
  For j = 0 To intlbls 
    Set myctrl = mysec.Controls(j) 
    ctrlIndex(j) = myctrl.ControlType 
    ctrlName(j) = myctrl.NAME 
  Next 
  For j = 0 To intlbls 
    If ctrlIndex(j) = 100 Then 
      DeleteControl MyFrm.NAME, ctrlName(j) 
    End If 
  Next 
intlbls = mysec.Controls.Count - 1 
Set myctrl = mysec.Controls(intlbls)
With myctrl 
  lngx = .Left 
  lngY = .Top 
  lngW = .Width 
  lngH = .Height 
  ctrltype = .ControlType 
  strFont = .FontName 
  intFntSize = .FontSize 
  intFntWeight = .FontWeight 
End With 
End If 

i = 0.0104 * 1440 + lngH ' 0.0104 inches 
lngY = lngY + i 
For j = intlbls + 1 To intNooflabels 

  Set newctrl = CreateControl(MyFrm.NAME, ctrltype, _acDetail, "","", lngx, lngY, lngW, lngH) 

  If ctrltype = 100 Then 
    newctrl.Caption = strCap 
    newctrl.FontName = strFont 
    newctrl.FontSize = intFntSize 
    newctrl.FontWeight = intFntWeight 
  Else 
    newctrl.ControlSource = strCap 
    newctrl.FontName = strFont 
    newctrl.FontSize = intFntSize 
    newctrl.FontWeight = intFntWeight 
  End If 
lngY = lngY + i 
Next 
End If 

If intlbls > intNooflabels Then 
  For j = intNooflabels + 1 To intlbls 
    Set myctrl = mysec.Controls(j) 
    ctrlIndex(j) = myctrl.ControlType 
    ctrlName(j) = myctrl.NAME 
  Next 
  For j = intNooflabels + 1 To intlbls 
    DeleteControl MyFrm.NAME, ctrlName(j) 
  Next 
  Validate_Dup = 0 
End If 

intlbls = mysec.Controls.Count - 1 
Set myctrl = mysec.Controls(0) 
ctrltype = myctrl.ControlType 
If ctrltype = 109 Then 
  For j = 0 To intlbls 
    Set myctrl = mysec.Controls(j) 
    With myctrl 
     .Enabled = False 
     .Locked = True 
     .SpecialEffect = 0 
    End With 
  Next 
End If 
Validate_Dup = 0 

Validate_Dup_Exit: 
Exit Function 

Validate_Dup_Err: 
MsgBox Err.Description, ,"Validate_Dup" 
Validate_Dup = 1 
Resume Validate_Dup_Exit 
End Function

Public Function MsgLabel() 
'------------------------------------------------------------ 
'Author : a.p.r. pillai 
'Date : September 2006 
'------------------------------------------------------------
Dim mySection As Section, ctl As Control, xForm As Form 
Dim l As Long, t As Long, w As Long, h As Long, F As Long 
F = 1440 
l = 0.5 * F: t = 1.2 * F: w = 3.6563 * F: h = 0.4896 * F 'values in inches 
On Error Resume Next 
Set mySection = MyFrm.Section(acDetail) 
Set ctl = CreateControl(MyFrm.NAME, acLabel, _acDetail, , "", l, t, w, h) 
ctl.Caption = "Click outside the Controls and Drag Over. "  & "Display the Property Sheet. " & "Type New Text for Caption/Control " & "Source Property area for Label/ Text Boxes. " & "Copy and Paste the Controls to " & "Target Form/Report Area." 
End Function

Public Function Border2D(ByVal intForeColor As Integer, _
ByVal intBorderColor As Integer, Optional ByVal Label0Text1 As Integer) As String
'------------------------------------------------------------  
'Author : a.p.r. pillai  
'Date : September 2006  
'------------------------------------------------------------
Dim intlbls As Integer  
Dim j As Integer, ForeColor As Long, BorderColor As Long  
Dim lblName() As String, X As Integer, mySection As Section  
Dim l As Long, t As Long, intFSize As Integer
On Error Resume Next
  
Border2D = FormTxtLabels(Label0Text1)  
Set mySection = MyFrm.Section(acDetail)  
intlbls = mySection.Controls.Count - 1  
On Error GoTo Border2D_Err  
X = Validate_Dup(MyFrm, 5) ' check type and duplicate  
If X = 1 Then  
     Exit Function  
End If  
intlbls = mySection.Controls.Count - 1  
X = intForeColor  
intForeColor = IIf(X < 0, 0, IIf(X > 15, 15, intForeColor))  
X = intBorderColor  
intBorderColor = IIf(X < 0, 0, IIf(X > 15, 15, intBorderColor))
  
ReDim lblName(0 To intlbls) As String  

ForeColor = QBColor(intForeColor)   
BorderColor = QBColor(intBorderColor)    
For j = 0 To intlbls   
   lblName(j) = mySection.Controls(j).NAME   
Next    
For j = 0 To intlbls   
With mySection.Controls(lblName(j))   
    .Height = lngheight   
    .Width = lngWidth   
    .FontName = "Times New Roman"   
    intFSize = .FontSize   
If intFSize < intFontSize Then   
    .FontSize = intFontSize   
End If   
    .FontUnderline = False   
    .TextAlign = intTextAlign   
    .BackStyle = intBackStyle   
End With   
Next    
mySection.Controls(lblName(intlbls))
    .ForeColor = ForeColor    
For j = 0 To intlbls - 1   
     mySection.Controls(lblName(j)).ForeColor = BorderColor   
Next    
l = intX: t = intY    
With mySection.Controls(lblName(4))   
    .Left = l   
    .Top = t   
End With    
For j = 0 To intlbls - 1   
With mySection.Controls(lblName(j))   
If j = 0 Or j = 3 Then  .Left = l - LngI    
If j = 1 Or j = 2 Then  .Left = l + LngI    
If j = 0 Or j = 1 Then .Top = t    
If j = 1 Then .Top = t - (0.0104 * 1440)    
If j = 0 Then .Top = t + (0.0104 * 1440)    
If j = 2 Then .Top = t + LngI    
If j = 3 Then .Top = t - LngI    
End With   
Next   
MsgLabel    
Border2D_Exit:   
Exit Function    

Border2D_Err:   
MsgBox Err.Description,, "Border2D"   
Resume Border2D_Exit   
End Function

Note: Before running this function, make sure that all essential library references—outlined in my earlier article, Command-Button Animation—are properly linked to your project. Additionally, the main procedures provided under the topic Create 3D Headings on Forms are also required. If you haven’t already done so, copy and paste those programs into a global module in your project.

The above function will create a new form and design the heading text on it in seconds. You can copy & paste it anywhere on Forms or Reports you like and customize it with the required text, text size, color, and text in bold or italics.

How to Run the Code Manually.

Open the VBA Module Window (if not already open) by pressing Alt+F11, then press Ctrl+G to open the Immediate Window (Debug window).

Command Syntax:

Border2D TextForeColor, TextBorderColor, Label, or Text

Type the following and press the Enter key in the Debug Window:

Border2D 4,15,0

If you prefer to run the program with a Command Button Click Event Procedure, then you must use text boxes on the Form to set the parameter values of the function and use references to the text boxes in command parameters.

Example:

Private Sub cmdBorder2D_Click()
   Border2D Me![txtForeColor], Me![txtBorderColor],0
End Sub

The first two parameter values define the text's foreground color and border color, respectively (value range: 0 to 15). The third parameter determines the type of control: a value of 0 creates a label-based design, while 1 creates a textbox-based design. This third parameter is optional—if omitted, the function defaults to creating a label-based design.

QBColor	Description	QBColor	Description
0	Black	8	Gray
1	Blue	9	Light Blue
2	Green	10	Light Green
3	Cyan	11	Light Cyan
4	Red	12	Light Red
5	Magenta	13	Light Magenta
6	Yellow	14	Light Yellow
7	White	15	Bright White

The module window will briefly flash, indicating a refresh. Press Alt+F11 to toggle back to the database window, where you’ll see a new form named Form1. This form will contain the Border2D heading with a white border already applied.

Customizing Text Properties.

Once the heading is created, you can customize the text, adjust the font size, change the foreground and border colors, and apply styles such as bold or italic.

To change the Heading Text, Text Style, Border Color, and Text Color:

Select all the controls together, open the Property Sheet, and change the Caption to the text of your choice. While all the labels remain selected, you can make the text bold, italic, or adjust the font size. Choose a border color from the color palette—this will apply the selected color as the foreground color to all labels. Next, carefully click only on the top label and change its foreground color to distinguish it from the others.