ju*********@gmail.com wrote:
That does indeed sound like very nice code to have around. I'm guessing
by the fact that you didn't post it that you don't want to or can't do
so. Bummer. It would be great to be able to share that with folks.
I don't mind, but it's highly personalized. You will have to go back
and edit it for your particular case. The lnk, btn, and msk objects are
user-defined class objects that I use repeatedly.
DSDAutoformat is the function that is attached to the CommandBarButton,
iName sets the control naming convention prefix.
WATCH FOR WORD WRAP!
' **********************Begin
Code******************************************
Public Function DSDAutoFormat()
' Callers: CommandBars("DataSorceryDesign").Controls("DataSor cery
Auto&Format...")
' Purpose: This function may be attached to a CommandBarButton to
' format all controls on the form IAW standard naming conventions.
' Assumptions: That it is being called with a form in design view
' as the currently selected object. User or system has prepared
' the StatusBarText property of all controls, as appropriate.
' This property will be copied to the ControlTipText property
' for the control itself and any child controls or attached
' labels.
' Calls: iName
' Notes: For bound forms, the 'Description' property of each
' field in the underlying table will automatically be included
' as that field's bound control's 'StatusBarText' property.
' Where 'StatusBarText' is not populated automatically, it should
' be provided by the developer prior to running this routine.
On Error GoTo Err_DSDAutoFormat
DoCmd.Hourglass True
Dim frm As Form, ctl As Control, ctl2 As Control
Dim strX(1) As String, strTip As String, strExclude As String
If Screen.ActiveForm.CurrentView <0 Then GoTo Exit_DSDAutoFormat
' Set form reference and prep counters
Set frm = Screen.ActiveForm
i = 0
j = 0
' Initiate progress meter
Call SysCmd(acSysCmdInitMeter, "Formatting parent controls:", _
frm.Controls.Count)
' Loop through controls to set properties
For Each ctl In frm.Controls
strTip = ""
strX(1) = ""
If ctl.Controls.Count 0 And ctl.ControlType <112 _
And ctl.ControlType <123 _
And ctl.ControlType <124 Then
' Control has attached controls and is not a subform,
' tab control, or tab control page
strTip = ctl.StatusBarText
' Prepare naming convention prefix
strX(0) = iName(ctl)
' Prepare naming convention subject
If ctl.ControlSource <"" _
And Left(ctl.ControlSource, 1) = "=" Then
' Calculated control
strX(1) = "Calc" & i
ElseIf ctl.ControlSource <"" Then
' Bound control
strX(1) = Replace(ctl.ControlSource, " ", "_")
Else
' Unbound control
strX(1) = "Ubd" & i
End If
' Check current ctl.Name for conventional format
' Button and mask objects excluded
If InStr(1, Left(ctl.Name, 3), strX(0), _
vbBinaryCompare) = 0 _
And Left(ctl.Name, 3) <"btn" _
And Left(ctl.Name, 3) <"msk" Then _
ctl.Name = strX(0) & IIf(strX(1) = "", i, strX(1))
' Set ControlTipText to StatusBarText
ctl.ControlTipText = IIf(strTip = "", _
ctl.ControlTipText, strTip)
' Preserve ctl.Name in exclusion string
strExclude = strExclude & "/" & ctl.Name
On Error GoTo Err_Controls
' Loop through attached/child controls
For Each ctl2 In ctl.Controls
' Prepare naming convention prefix
strX(0) = iName(ctl2)
' Set ControlTipText to Parent.StatusBarText
ctl2.ControlTipText = IIf(strTip = "", _
ctl2.ControlTipText, strTip)
' Check current ctl2.Name for conventional format
' Button and mask objects excluded
If InStr(1, Left(ctl2.Name, 3), strX(0), _
vbBinaryCompare) = 0 _
And Left(ctl2.Name, 3) <"btn" _
And Left(ctl2.Name, 3) <"msk" Then _
ctl2.Name = strX(0) & IIf(strX(1) = "", i, _
strX(1))
' Preserve ctl2.Name in exclusion string
strExclude = strExclude & "/" & ctl2.Name
Skip_ControlsCollection:
Next ctl2
On Error GoTo Err_DSDAutoFormat
End If
Skip_Controls:
' Increment control index counter and progress meter
i = i + 1
Call SysCmd(acSysCmdUpdateMeter, i)
Next ctl
' Remove progress meter
Call SysCmd(acSysCmdRemoveMeter)
On Error GoTo Err_SingleControls
' Prep counter
i = 0
' Initiate progress meter
Call SysCmd(acSysCmdInitMeter, "Formatting controls:", _
frm.Controls.Count)
' Loop through controls
For Each ctl In frm.Controls
strTip = ""
strX(1) = ""
' Control props not already set
If InStr(1, strExclude, ctl.Name) = 0 Then
strTip = ctl.StatusBarText
' Prepare naming convention prefix
strX(0) = iName(ctl)
' Prepare naming convention subject
If ctl.ControlSource <"" _
And Left(ctl.ControlSource, 1) = "=" Then
' Calculated control
strX(1) = "Calc" & i
ElseIf ctl.ControlSource <"" Then
' Bound control
Else
' Unbound control
strX(1) = "Ubd" & i
End If
' Set ControlTipText to StatusBarText
ctl.ControlTipText = IIf(strTip = "", _
ctl.ControlTipText, strTip)
' Check current ctl2.Name for conventional format
' Button and mask objects excluded
If InStr(1, Left(ctl.Name, 3), strX(0), _
vbBinaryCompare) = 0 _
And Left(ctl.Name, 3) <"btn" _
And Left(ctl.Name, 3) <"msk" Then _
ctl.Name = strX(0) & IIf(strX(1) = "", i, strX(1))
End If
Skip_UniqueControls:
' Increment control index counter and progress meter
i = i + 1
Call SysCmd(acSysCmdUpdateMeter, i)
Next ctl
Exit_DSDAutoFormat:
' Remove progress meter and hourglass
Call SysCmd(acSysCmdRemoveMeter)
DoCmd.Hourglass False
' Free object variable memory allocation
Set frm = Nothing
Exit Function
Err_DSDAutoFormat:
' Standard error handling
Select Case Err.Number
' Object does not support this property or method.
Case 438
Resume Next
' You entered the control name '???' which is already in use.
Case 2104
ctl.Name = strX(0) & strX(1) & i
Resume Next
' You entered an expression that has an invalid reference to the
property Controls.
Case 2455
Resume Skip_Controls
' You entered an expression that requires a form to be the
' active window.
' The form did not have the focus when the command was launched
Case 2475
MsgBox "Please ensure that the desired form is " _
& "has the focus and is in design mode.", vbOKOnly, _
"DataSorcery Toolbar Error"
Response = vbIgnore
Resume Exit_DSDAutoFormat
' All other errors handled without breaking to code.
Case Else
MsgBox "DataSorcery AutoFormat code error (" & Err.Number _
& "): " & StrBR(2) & Err.Description & StrBR(2) _
& "Please advise your system administrator of " _
& "this error. Control " & i & " (" & ctl.Name _
& ") could not be formatted.", vbOKOnly, _
"DataSorcery Toolbar Error"
Response = vbAbort
Resume Exit_DSDAutoFormat
End Select
Err_Controls:
' Error handling for ctl.Controls loop
Select Case Err.Number
' Object does not support this property or method.
Case 438
Resume Next
' You entered the control name '???' which is already in use.
Case 2104
ctl2.Name = strX(0) & strX(1) & j
j = j + 1
Resume Next
' You entered an expression that has an invalid reference to the
property Controls.
Case 2455
Resume Skip_ControlsCollection
' All other errors handled without breaking to code.
Case Else
MsgBox "DataSorcery Controls code error (" & Err.Number _
& "): " & StrBR(2) & Err.Description & StrBR(2) _
& "Please advise your system administrator of " _
& "this error. Control " & i & " (" & ctl.Name _
& "." & ctl2.Name & ") could not be formatted.", _
vbOKOnly, "DataSorcery Toolbar Error"
Response = vbAbort
Resume Exit_DSDAutoFormat
End Select
Err_SingleControls:
' Error handling for individual control loop
Select Case Err.Number
' Object does not support this property or method.
Case 438
Resume Next
' You entered the control name '???' which is already in use.
Case 2104
ctl.Name = strX(0) & strX(1) & i
Resume Next
' You entered an expression that has an invalid reference to the
property Controls.
Case 2455
Resume Skip_UniqueControls
' All other errors handled without breaking to code.
Case Else
MsgBox "DataSorcery UniqueControls code error (" &
Err.Number _
& "): " & StrBR(2) & Err.Description & StrBR(2) _
& "Please advise your system administrator of " _
& "this error. Control " & i & " (" & ctl.Name _
& ") could not be formatted.", vbOKOnly, "DataSorcery
Toolbar Error"
Response = vbAbort
Resume Exit_DSDAutoFormat
End Select
End Function
Private Function iName(ctl As Control) As String
' Callers: DSDAutoFormat
' Purpose: Sets naming convention prefix for controls, by type.
' Assumptions: Assumes attached labels have less than 48
' properties in all versions, and that those that are unattached
' have 48 in all versions prior to A2k3.
Dim sngLnkProps As Single
' Detect Access version for detached label identification
sngLnkProps = IIf(Application.Version >= 11, 49, 48)
' Set prefix
Select Case ctl.ControlType
Case 100 ' Label
If ctl.Properties.Count <sngLnkProps Then
' Attached label
iName = "lbl"
ElseIf Nz(ctl.HyperlinkAddress) = "" _
And Nz(ctl.HyperlinkSubAddress) = "" Then
' Detached label not used as Hyperlink
iName = "lbl"
Else
' Detached label used as Hyperlink
iName = "lnk"
End If
Case 101 ' Rectangle
iName = "box"
Case 102 ' Line
iName = "lin"
Case 103 ' Image
iName = "img"
Case 104 ' Command button
iName = "cmd"
Case 105 ' Option button
iName = "opt"
Case 106 ' Check box
iName = "chk"
Case 107 ' Option group
iName = "ogp"
Case 109 ' Text box
iName = "txt"
Case 110 ' List box
iName = "lst"
Case 111 ' Combination box
iName = "cbo"
Case 112 ' Subform
iName = "sfm"
Case 118 ' Page break
iName = "brk"
Case 122 ' Toggle button
iName = "tog"
Case 123 ' Tab control
iName = "tab"
Case 124 ' Page on tab control
iName = "pag"
Case Else ' Any other control type
iName = "ctl"
End Select
End Function
' ************************End
Code******************************************
Have fun with that one.