BORDER3D HEADING ~ LEARN MS-ACCESS TIPS AND TRICKS

Introduction.

If you've arrived directly on this page, please refer to my earlier article, Command-Button Animation, for instructions on linking the essential library files to your project. That article includes the list of required library files and step-by-step guidelines for attaching them. These libraries are necessary for running the program described on this page successfully.

The function below creates an attractive and visually engaging heading style, similar to the sample image shown above. After generating the sample heading on a new form, you can customize the font, style (Bold, Italic), shadow, border, and text color to suit your preferences.

Copy and paste the VBA code below into a new global module in your database. If you’ve already added the first three functions (listed below) along with the Global declarations from the earlier post Create 3D Headings on Forms, then you only need to copy and paste the final function: Border3D.

The following common functions are used by the main program Border3D for all other 2D/3D styles:

FormTxtLabels()
Validate_Dup()
MsgLabel()

The Functions VBA Code.

If you have already copied the above functions earlier, then copy only the last Function: Border3D

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

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 Border3D(ByVal intStyle As Integer, 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, I As Long, intFSize As Integer
On Error Resume Next
 I = 0.0104 * 1440 ' 0.0104 inches
 Border3D = FormTxtLabels(Label0Text1)
 Set mySection = MyFrm.Section(acDetail)
 intlbls = mySection.Controls.Count - 1 
On Error GoTo Border3D_Err
 X = Validate_Dup(MyFrm, 7) ' 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))
 X = intStyle
 intStyle = IIf(X < 0, 0, IIf(X > 3, 3, intStyle)) 
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(intlbls))
   .Left = l
   .Top = t
 End With 
For j = 2 To intlbls - 1
   With mySection.Controls(lblName(j))
      Select Case j
         Case 2
           .Left = l + I
           .Top = t + I
         Case 3
           .Left = l + I
           .Top = t - I
         Case 4
           .Left = l - I
           .Top = t + I
         Case 5
           .Left = l - I
           .Top = t - I
      End Select
   End With
 Next
   For j = 0 To 1
    With mySection.Controls(lblName(j))
     '.ForeColor = 9868950
     .ForeColor = 0
    If j = 0 Then
     Select Case intStyle
        Case 0
            .Left = l - (I * 3)
            .Top = t - (I * 3)
        Case 1
            .Left = l - (I * 3)
            .Top = t + (I * 3)
        Case 2
            .Left = l + (I * 3)
            .Top = t - (I * 3)
        Case 3
            .Left = l + (I * 3)
            .Top = t + (I * 3)
     End Select
   Else
     Select Case intStyle
          Case 0
            .Left = l - (I * 2)
            .Top = t - (I * 2)
        Case 1
            .Left = l - (I * 2)
            .Top = t + (I * 2)
        Case 2
            .Left = l + (I * 2)
            .Top = t - (I * 2)
        Case 3
            .Left = l + (I * 2)
            .Top = t + (I * 2)
     End Select
   End If
     End With
 Next
 MsgLabel
 Border3D_Exit:
 Exit Function

 Border3D_Err:
 Msgbox Err.Description,, "Border3D"
 Resume Border3D_Exit
 End Function

How to Create

To create the Border3D Heading Text, press ALT+F11 to open the VBA Window and press Ctrl+G to display the Debug Window (Immediate Window). Type the following line in the immediate window and press the Enter key:

Border3D 1,4,15,0

The module window will flash for a moment as if it has been refreshed. Minimize the VBA Window, and you will see a new form created and kept minimized on the taskbar by the program. Restore the form and save it, with the Heading Text.

First, let’s get familiar with the parameter values of the function. The first three parameters are mandatory — if any of them is omitted, the program will display an error message: "Parameter not optional." The fourth parameter is optional.

Parameter Values

The first parameter value represents the shadow position. The value range and their shadow positions are as given below:

0 - Top Left
1 - Bottom Left
2 - Top Right
3 - Bottom Right

By using one of the four values as the first parameter, you can display the shadow tilted to any one of the four corners of the heading.

The second parameter value 4 (Red Color) is the Text color, and the value range is 0 to 15. You can find the color numbers and their description here.

The third parameter value 15 creates a white-colored border around the text. The valid range of values is from 0 to 15.

The fourth parameter is optional. If omitted, a default value 0 is assumed, which creates a Label-based heading. A value of 1 creates a TextBox-based heading.

Customizing Text

After creating the 3D heading, you can select all the labels together by clicking and holding the left mouse button just outside the group, then dragging the mouse over them. Once selected, press F4 or go to View → Properties to display the Property Sheet. From there, update the Caption property with your desired text. You can also customize the font, font size, and apply styles like Bold or Italic as per your preference.

How to Copy and Reuse the 3D Heading

Deselect All Labels:
- Click anywhere on the form outside the label group to deselect it.
Change the Foreground Color of the Top Label:
- Carefully click only on the topmost label.
- Change its fore-color to the heading color of your choice.
- Be cautious not to move the label out of alignment.
Select All Labels Again:
- Click and drag your mouse to select all the labels together, just like before.
Copy the Labels:
- Press Ctrl + C to copy the selected labels to the clipboard.
Open Target Form/Report:
- Open the target Form or Report in Design View.
Paste the Heading:
- Press Ctrl + V to paste the heading onto your form or report.
Save as a Template (Optional):
- Save the current form as a template, so you can copy and modify the 3D heading on other forms or reports.