Public Sub ActiveFormRenameControls() '131112, strive4peace
'FORM MUST BE IN DESIGN VIEW AND ACTIVE ' Code only changes names. The form is not saved ~ ' Compile code and decide if you like what was done - if so, you can Save 'RENAME ' bound controls to match ControlSource ' labels: ' associated: controlname_Label ' unassociated: Label_controlname 'Click HERE and press F5 to Run!
On Error GoTo Proc_Err
Dim ctl As Control _ , ctl2 As Control Dim sControlSource As String _ , sLabelName As String _ , sLabelName2 As String _ , iCountName As Integer _ , iCountLabel As Integer iCountName = 0 iCountLabel = 0 With Screen.ActiveForm If MsgBox(.Name _ & vbCrLf & vbCrLf & "Rename bound controlnames to be the field they are bound to? " _ & vbCrLf & vbCrLf & "... and associated Label controlnames to Controlname_Label?" _ & vbCrLf & "... and unassociated Label controlnames to Label_Controlname?" _ , vbYesNo, "Rename Controls on " & .Name & "?") = vbNo Then Exit Sub For Each ctl In .Controls If ctl.ControlType <> acLabel Then sControlSource = Nz(Get_Property_relinker("controlsource", ctl), "") If Len(sControlSource) > 0 Then If Left(sControlSource, 1) <> "=" Then If ctl.Name <> sControlSource Then ctl.Name = sControlSource iCountName = iCountName + 1 End If sLabelName = sControlSource & "_Label" 'associated sLabelName2 = "Label_" & sControlSource 'unassociated Else sLabelName = ctl.Name & "_Label" sLabelName2 = "Label_" & ctl.Name 'unassociated sControlSource = ctl.Name End If If ctl.Controls.Count > 0 Then With ctl.Controls(0) If .ControlType = acLabel Then If .Name <> sLabelName Then .Name = sLabelName iCountLabel = iCountLabel + 1 End If End If End With Else 'no associated label 'look for a label whose caption is the control source For Each ctl2 In .Controls If ctl2.ControlType = acLabel Then If ctl2.Caption = sControlSource Then If ctl2.Name <> sLabelName2 Then ctl2.Name = sLabelName2 iCountLabel = iCountLabel + 1 End If End If End If Next ctl2 End If End If 'Len(sControlSource) > 0 End If 'not a label Next ctl End With MsgBox "Renamed " & iCountName & " controls, " _ & iCountLabel & " Labels" _ , , "Done" Proc_Exit: On Error Resume Next 'release object variables Set ctl = Nothing Set ctl2 = Nothing Exit Sub Proc_Err: 'err 2104 'name already in use -- fix this manually or modify this code MsgBox Err.Description, , _ "ERROR " & Err.Number _ & " ActiveFormRenameControls"
Resume Proc_Exit Resume End Sub |