by VB-Kung-Fu (19 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 9th December 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Generates and sets field captions from the field names(useful when creating data entry forms)
API Declarations
'field caption to name a label for a controls on a form, that allow data
'for the fields to be specified. So if you have a table with two fields
'EMPLOYEE_NAME and EMPLOYEE_AGE, this routine will set the captions to
'"Employee Name" and "Employee Age" and later when you create a form
'for the table Access automatically creates labels for these two fields
'using the 'clean' captions instead of the more arcane EMPLOYEE_NAME
'and EMPLOYEE_AGE field names
VBcoders
'*******************************************************
'SetFieldCaptionsFromFieldNames
' Goes through the fields of the specified table
' and sets the field caption to the friendly
' version of the field name.
'*******************************************************
Public Sub SetFieldCaptionsFromFieldNames(TblName As String)
Dim tdf As TableDef, fld As Field, prop As Property, PropFound As Boolean
If TblName = "" Then Exit Sub
For Each tdf In CurrentDb.TableDefs
If StrComp(tdf.Name, TblName, vbTextCompare) = 0 Then
For Each fld In tdf.Fields
PropFound = False 'always assume the property doesnt exist
For Each prop In fld.Properties
If StrComp(prop.Name, "caption", vbTextCompare) = 0 Then
prop.Value = MakeFieldNameFriendly(fld.Name)
PropFound = True
Exit For
End If
Next
If PropFound = False Then
' the caption property doesnt exist so we add it
Set prop = fld.CreateProperty("Caption", dbText, MakeFieldNameFriendly(fld.Name))
Call fld.Properties.Append(prop)
End If
Next
Exit Sub
End If
Next
MsgBox "Table '" & TblName & "' does not exist in this database"
End Sub
'*******************************************************
'MakeFieldNameFriendly
' Takes a string representing a field name and
' makes it friendly by replacing underscores with
' spaces, and changing the capitalisation so only
' the first letter of each word is capitalised.
'*******************************************************
Public Function MakeFieldNameFriendly(FldName As String) As String
Dim res As String, n As Long, UnderscoreSeen As Boolean, char As String * 1
If FldName = Empty Then
Exit Function
Else
'lower the case of every letter
res = LCase(FldName)
'set this to true so that if the field name
'begins with a letter, that letter will be
'capitalised
UnderscoreSeen = True
'go through the string replacing underscores with spaces
'and capitalising the first letter of each word
For n = 1 To Len(res)
char = Mid(res, n, 1) 'select a character
If InStr(1, "abcdefghijklmnopqrstuvwxyz", char) Then
'if its a letter and it was preceded by an underscore
'then its the first letter of a word and needs to be
'capitalised
If UnderscoreSeen Then
Mid(res, n, 1) = UCase(char)
UnderscoreSeen = False
End If
ElseIf char = "_" Then
'replace underscore with spaces
Mid(res, n, 1) = " "
UnderscoreSeen = True
Else
'the character is probably a number and we leave it as is
UnderscoreSeen = False
End If
Next
MakeFieldNameFriendly = res
End If
End Function
No comments have been posted about Generates and sets field captions from the field names(useful when creating data entry forms). Why not be the first to post a comment about Generates and sets field captions from the field names(useful when creating data entry forms).
