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.
Downloads
Download Demo Database
