Creating the LNC Control Renaming COM Addin

The procedures that do the renaming of form and report controls in the LNC Control Renaming COM add-in are basically the same as the LNC Rename Access add-in, which was covered in detail in my earlier book Expert One-on-One Microsoft Access Application Development; this chapter concentrates on the differences needed to make the code work in a COM add-in.

For more details on the LNC Rename add-in, see my book Expert One-on-One Microsoft Access Application Development (ISBN: 0764559044).

The SharedCode Module

Starting with a project created from the COM add-in project template, in the SharedCode module, I removed the standard declarations (the only declarations I need are the ones in the AccessDesigner module), and I also removed the standard AddToCommandBar and DeleteFromCommandBar functions. Because I needed to create (and remove) two command bar buttons, intended specifically for the Access Form Design and Report Design toolbars, I placed those procedures in the Access Designer.

I added the StripChars function to this module; it is called throughout the add-in to remove various characters and spaces from control names during renaming, so as prevent problems when the controls are referenced in code. I modified the standard template AddlnErr procedure slightly; it creates a message box string that is called from error handlers in the add-in. The SharedCode module that contains these procedures is listed next:

Option Explicit

Public Function StripChars(strText _ As String) As String

Strips a variety of non-alphanumeric characters from a text string.

On Error GoTo ErrorHandler

Dim strTestString As String Dim strTestChar As String Dim lngFound As Long Dim i As Integer Dim strStripChars As String strStripChars = " "[email protected]#$%^&*()-_=+[{]};:,,<.>/?" _

& Chr$(34) & Chr$(13) & Chr$(10) strTestString = strText i = 1

Do While i <= Len(strTestString)

Find a strippable character.

strTestChar = Mid$(strTestString, i, 1) lngFound = InStr(strStripChars, strTestChar) If lngFound > 0 Then strTestString = Left(strTestString, i - 1) _ & Mid(strTestString, i + 1)

StripChars = strTestString

ErrorHandlerExit: Exit Function

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Function

Public Sub AddInErr(errX As ErrObject) Displays message box with error information Dim strMsg As String strMsg = _

"An error occurred in the " & App.Title _ & vbCrLf & "Error #:" & errX.Number _ & vbCrLf & "Description: " & errX.Description MsgBox strMsg, , "Error!"

End Sub

The AccessDesigner Module

The COM add-in needs several entries in the Declarations section of the AccessDesigner module. To open the designer module, open the Designers folder in the project tree, right-click the AccessDesigner item, and select View Code from the context menu, as shown in Figure 13.7.

FIGURE 13.7

Opening the AccessDesigner code module.

FIGURE 13.7

The standard designer code needs some modifications to enable it to work with add-in events that fire when the add-in is loaded or unloaded, or when the host application (Access in this case) starts or shuts down. These events are implemented via the IDTExtensibility2 library, using the Implements line at the beginning of the module.

The procedures starting with Private Sub IDTExtensibility2 are the events supported by this library. You need to have all five event procedures in the Designer module, even though your add-in may not use all of them. The ones I don't need have only a comment line:

'No code needed, but must have the event stub

COM add-ins generally put one or more buttons or commands on a toolbar or menu in the host application; each one requires a WithEvents statement in the Declarations section of the Designer module, to support code on the Click event of the button or command. My LNC Control Renaming code has two such events, to support two toolbar buttons.

The remainder of the Declarations section contains groups of public and private variables for use in various add-in procedures. The procedures in this module have the functionality described next:

■ The OnConnection event procedure sets the command bar button variables, and uses the CreateFormCommandBarButton and CreateReportCommandBarButton functions to create the buttons on the Form Design (or Report Design) Access toolbars (in older versions of Access), or in the Toolbar Commands group on the backward compatibility Add-Ins tab of the Ribbon (in Access 2007 running on Windows XP).

■ The OnDisconnection event procedure runs a function that removes the two command bar buttons when the add-in is disconnected by unloading the add-in from the COM Add-Ins dialog (they are not removed when Access is closed).

■ The two Click event procedures run the LNCRenameFormControls and LNCRenameReportControls functions, which respectively rename form and report controls.

An Access 2000-2003 command bar button has its OnAction property set to the name of a macro (a Sub procedure with no arguments) that is run when the button is clicked; the syntax is different for buttons placed on command bars from a COM add-in. Instead, the OnAction property is set to the ProgId of the COM add-in, and the button's Click event is handled by the Click event procedure in the Designer module.

■ The CreateFormCommandBarButton creates the Access toolbar button that renames controls on open forms. The function first sets the pappAccess variable to the Access.Application object, then sets a reference to the Form Design toolbar (where the button will be placed), looking for an existing button on this toolbar, using its Tag property, and creating it if it does not already exist.

■ The CreateReportCommandBarButton procedure does a similar job for the Report Design toolbar button that renames report controls.

■ The RemoveAddlnCommandBarButton function (called by the OnDisconnection event procedure) removes the add-in's command buttons.

■ The LNCRenameFormControls and LNCRenameReportControls functions are basically similar to the code in the Access LNC Rename add-in, so I will not discuss them in detail. The main difference is that the COM add-in functions rename controls on the open forms (or reports) only; the Rename Form Controls and Rename Report Controls menu add-ins rename controls on all forms or reports, whether or not they are open.

The AccessDesigner code is listed next, with the specific modifications needed to implement the add-in's functionality, using the event procedures supported by the IDTExtensibility2 library to create command bar buttons, and assign procedures to them. The module also contains the procedures used to do control renaming:

Implements IDTExtensibility2

Private WithEvents frmcbb As Office.CommandBarButton Private WithEvents rptcbb As Office.CommandBarButton

Global variable to store reference to host application (Access)

Public pappAccess As Access.Application

Regular variables for creating toolbar buttons

Private cbrMenu As Office.CommandBar Private cbbAddIn As Office.CommandBarButton

Public variables for handling renaming

Public pctl As Access.Control Public pdbs As DAO.Database Public pfrm As Access.Form Public pintRenameFail As Integer Public pintReturn As Integer Public plngControlType As Long Public prpt As Access.Report Public prst As DAO.Recordset Public pstrMessage As String Public pstrNewCtlName As String Public pstrOldCtlName As String Public pstrSQL As String Public pstrSourceObject As String

Private variables for handling renaming

Private i As Integer Private blnTag As Boolean Private intTag As Integer Private strPrefix As String Private blnUnbound As Boolean Private strControlSource As String Private strCaption As String Private strObjectName As String Private strCtlName As String

Constants for characters surrounding ProgID

Const PROG_ID_START As String = "!<" Const PROG_ID_END As String = ">"

Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)

On Error GoTo ErrorHandler

'No code needed, but must have the event stub

ErrorHandlerExit: Exit Sub

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Sub

Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)

On Error GoTo ErrorHandler

'No code needed, but must have the event stub

ErrorHandlerExit: Exit Sub

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Sub

Private Sub IDTExtensibility2_OnConnection(ByVal _ Application As Object, ByVal ConnectMode _ As AddInDesignerObjects.ext_ConnectMode, _ ByVal AddInInst As Object, custom() As Variant)

Calls shared code to create a new command bar button to rename controls on a form or report.

On Error GoTo ErrorHandler

Set frmcbb = CreateFormCommandBarButton(Application, _

ConnectMode, Addlnlnst) Set rptcbb = CreateReportCommandBarButton(Application, _ ConnectMode, Addlnlnst)

ErrorHandlerExit: Exit Sub

ErrorHandler: AddlnErr Err Resume ErrorHandlerExit

End Sub

Private Sub IDTExtensibility2_OnDisconnection(ByVal _

RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)

On Error GoTo ErrorHandler Call common procedure to disconnect add-in.

RemoveAddInCommandBarButton RemoveMode

ErrorHandlerExit: Exit Sub

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Sub

Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)

On Error GoTo ErrorHandler

'No code needed, but must have the event stub

ErrorHandlerExit: Exit Sub

ErrorHandler: AddlnErr Err Resume ErrorHandlerExit

End Sub

Private Sub frmcbb_Click(ByVal ctl As _

Office.CommandBarButton, CancelDefault As Boolean)

On Error Resume Next

Call LNCRenameFormControls

End Sub

Private Sub rptcbb_Click(ByVal ctl As _

Office.CommandBarButton, CancelDefault As Boolean)

On Error Resume Next

Call LNCRenameReportControls

End Sub

Public Function CreateFormCommandBarButton(ByVal _ Application As Object, ByVal ConnectMode _ As AddInDesignerObjects.ext_ConnectMode, _ ByVal Addlnlnst As Object) As Office.CommandBarButton

On Error GoTo ErrorHandler

Store a reference to the Application object in a public variable so other procedures in the add-in can use it.

Set pappAccess = Application Return a reference to the command bar..

Set cbrMenu = pappAccess.CommandBars("Form Design") Add a button to call the add-in from the command bar, if it doesn't already exist. Look for the button on the command bar.

cbrMenu.FindControl(Tag:="Rename Form Controls")

On Error Resume Next

If cbbAddIn Is Nothing Then

Add the new button.

cbrMenu.Controls.Add(Type:=msoControlButton, _ Parameter:="Rename Form Controls")

Set the button's Caption, Tag, Style, and OnAction properties.

With cbbAddIn

.Caption = "Rename &Form Controls" .Tag = "Rename Form Controls" .Style = msoButtonCaption

Run the main add-in function.

.OnAction = PROG_ID_START & Addlnlnst.ProgId _ & PROG_ID_END End With End If

On Error GoTo ErrorHandler

Return a reference to the new command bar button.

Set CreateFormCommandBarButton = cbbAddIn

ErrorHandlerExit: Exit Function

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Function

Public Function CreateReportCommandBarButton(ByVal _ Application As Object, ByVal ConnectMode As _ AddInDesignerObjects.ext_ConnectMode, _ ByVal AddInInst As Object) As Office.CommandBarButton

On Error GoTo ErrorHandler

Store a reference to the Application object in a public variable so other procedures in the add-in can use it.

Set pappAccess = Application

Return a reference to the command bar..

Set cbrMenu = pappAccess.CommandBars("Report Design") Add a button to call the add-in from the command bar, if it doesn't already exist. Look for the button on the command bar.

cbrMenu.FindControl(Tag:="Rename Report Controls") If cbbAddIn Is Nothing Then

Add the new button.

cbrMenu.Controls.Add(Type:=msoControlButton, _ Parameter:="Rename Report Controls")

Set the button's Caption, Tag, Style, and OnAction properties.

With cbbAddIn

.Caption = "Rename &Report Controls" .Tag = "Rename Report Controls" .Style = msoButtonCaption

Run the main add-in function.

.OnAction = PROG_ID_START & AddInInst.ProgId _ & PROG_ID_END End With End If

Return a reference to the new commandbar button.

Set CreateReportCommandBarButton = cbbAddIn

ErrorHandlerExit: Exit Function

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Function

Function RemoveAddInCommandBarButton(ByVal _

RemoveMode As AddInDesignerObjects.ext_DisconnectMode)

This procedure removes the command bar buttons for the add-in if the user disconnected it. On Error Resume Next

If the user unloaded the add-in, remove the button. Otherwise, the add-in is being unloaded because the application is closing; in that case, leave button as is.

Delete the custom command bar buttons.

With pappAccess.CommandBars("Form Design")

.Controls("Rename Form Controls").Delete End With

With pappAccess.CommandBars("Report Design")

.Controls("Rename Report Controls").Delete End With End If

ErrorHandlerExit: Exit Function

ErrorHandler: AddInErr Err Resume ErrorHandlerExit

End Function

Public Function LNCRenameFormControls() As Variant

Renames all the controls on open forms.

On Error Resume Next Generate table of control types to use in renaming controls (if it does not already exist). CreateCTTable On Error GoTo ErrorHandler Determine whether any forms are open, and exit if not.

If RemoveMode = ext_dm_UserClosed Then

If pappAccess.Forms.Count = 0 Then MsgBox "No forms are open; exiting GoTo ErrorHandlerExit End If

Determine whether original the control names should be stored in the Tag property.

pstrMessage = _

"When processing form controls, should the original " & "control name be saved to the control's Tag " _ & "property?"

intTag = MsgBox(pstrMessage, vbYesNo + vbQuestion + _ vbDefaultButton2, "Control Name Backup")

If intTag = vbYes Then blnTag = True

Else blnTag = False

End If

Process the open forms.

For Each pfrm In pappAccess.Forms

For Each pctl In pfrm.Controls strCtlName = pctl.Name plngControlType = pctl.ControlType blnUnbound = False

Select Case plngControlType

Controls with control source

Case acTextBox strPrefix = "txt"

i = ControlCS(pctl, strPrefix, blnTag)

Case acComboBox strPrefix = "cbo"

i = ControlCS(pctl, strPrefix, blnTag)

Case acCheckBox strPrefix = "chk"

strControlSource = pctl.ControlSource If blnUnbound = False Then i = ControlCS(pctl, strPrefix, blnTag) Else i = ControlNA(pctl, strPrefix, blnTag) End If

Case acBoundObjectFrame strPrefix = "frb"

i = ControlCS(pctl, strPrefix, blnTag)

Case acListBox strPrefix = "1st"

i = Contro1CS(pct1, strPrefix, blnTag)

Case acOptionGroup strPrefix = "fra"

i = Contro1CS(pct1, strPrefix, blnTag)

Case acOptionButton strPrefix = "opt"

strContro1Source = pct1.Contro1Source If b1nUnbound = Fa1se Then i = Contro1CS(pct1, strPrefix, b1nTag) E1se i = Contro1NA(pct1, strPrefix, b1nTag) End If

Controls with caption only

Case acTogg1eButton strPrefix = "tg1"

i = Contro1CA(pct1, strPrefix, b1nTag)

Case acLabel strPrefix = "lbl"

i = ControlCA(pctl, strPrefix, blnTag)

Case acCommandButton strPrefix = "cmd"

i = ControlCA(pctl, strPrefix, blnTag)

Controls with source object only

Case acSubform strPrefix = "sub"

i = ControlSO(pctl, strPrefix, blnTag)

Controls with none of the above

Case acObjectFrame strPrefix = "fru"

i = ControlNA(pctl, strPrefix, blnTag)

Case aclmage strPrefix = "img"

i = ControlNA(pctl, strPrefix, blnTag)

Case acTabCtl strPrefix = "tab"

i = ControlNA(pctl, strPrefix, blnTag)

Case acLine strPrefix = "lin"

i = ControlNA(pctl, strPrefix, blnTag)

Case acPage strPrefix = "pge"

i = ControlNA(pctl, strPrefix, blnTag)

Case acPageBreak strPrefix = "brk"

i = ControlNA(pctl, strPrefix, blnTag)

Case acRectangle strPrefix = "shp"

i = ControlNA(pctl, strPrefix, blnTag)

End Select Next pctl Next pfrm

Call MsgBox("All form controls renamed!", _ vbOKOnly, "Done")

ErrorHandlerExit: Exit Function

ErrorHandler:

If an option button or checkbox is unbound, set blnUnbound to True so the code uses the NA function instead of CS.

If Err.Number = 24 55 Then blnUnbound = True Resume Next Else

AddInErr Err Resume ErrorHandlerExit End If

End Function

[I am omitting the LNCRenameReportControls function from this listing, because it is substantially similar to the LNCRenameFormControls function.]

The following procedures rename form and report controls of various types. Controls are grouped depending on whether or not they are bound, and other relevant properties. Each group of controls (ControlCS, ControlCA, and so forth) needs different code to create an appropriate name for the control. The bound controls, for example, create a name using the name of the bound field; labels create a name using caption text, and so forth:

Public Function ControlCS(ctl As Access.Control, _ strPrefix As String, blnTag As Boolean) As Integer

Does group renaming of all controls with control sources on a form or report.

On Error GoTo ErrorHandler

Dim strControlSource As String strControlSource = Nz(ctl.ControlSource) pstrOldCtlName = ctl.ControlName

Check whether control already is correctly named and also special case for controls whose original name starts with "Option" or "Frame" (same first three letters as prefix).

If Left(pstrOldCtlName, 3) = strPrefix And _

Left(pstrOldCtlName, 6) <> "Option" And _

Left(pstrOldCtlName, 3) = strPrefix And _

Left(pstrOldCtlName, 5) <> "Frame" Then GoTo ErrorHandlerExit

If the control source is not empty, use it.

Elself strControlSource <> "" Then pstrNewCtlName = strPrefix & _ StripChars(strControlSource)

Else

Otherwise, use the original control name.

pstrNewCtlName = strPrefix & StripChars(pstrOldCtlName) End If

Fix name of "Page x of y" textbox controls on Database Wizard reports.

If pstrNewCtlName = "txtPagePageofPages" Then pstrNewCtlName = "txtPages" End If

Show the user

■ the original control name

■ the control type

■ control source

■ proposed new name and ask if the new name is acceptable.

pintRenameFail = True Do While pintRenameFail pintRenameFail = False pintReturn = MsgBox( _ "Rename " & _

DLookup("[ControlTypeName]", _ "zLNCtblControlType", _

"[ControlType] = " & ctl.ControlType) _ & " control currently named " _ & pstrOldCtlName & vbCrLf & _

"(control source: " & strControlSource & ") " & "to" & vbCrLf & pstrNewCtlName & "?", _ vbYesNo + vbQuestion + vbDefaultButtoni, _ "Rename control")

If the user clicks the Yes button, rename the control.

If pintReturn = vbYes Then If blnTag = True Then ctl.Tag = ctl.ControlName End If ctl.ControlName = pstrNewCtlName

Otherwise, pop up an input box to edit the name.

ElseIf pintReturn = vbNo Then pstrNewCtlName = _

InputBox("Modify new control name", _ "Rename control", pstrNewCtlName) ctl.ControlName = pstrNewCtlName

End If Loop

ErrorHandlerExit: Exit Function

ErrorHandler:

If the proposed control name is already in use, return to the renaming dialog.

pintRenameFail = True If Err.Number = 2104 Then

MsgBox "There is another control named " & _ pstrNewCtlName & "; please try again", , _ "Control Name Used" pstrNewCtlName = pstrNewCtlName & "1"

Else

AddlnErr Err Resume ErrorHandlerExit End If

Resume Next

End Function

Public Function ControlCA(ctl As Access.Control, _ strPrefix As String, blnTag As Boolean) As Integer

Does group renaming of all controls with captions on a form or report.

On Error GoTo ErrorHandler

Dim strCaption As String pstrOldCtlName = ctl.ControlName strCaption = ctl.Caption

If Left(pstrOldCtlName, 3) = strPrefix Then

Exit Function Elself strCaption <> "" Then

If Left(strCaption, 3) = "frm" Then pstrNewCtlName = strPrefix & _ Mid(StripChars(strCaption), 4) Elself Left(strCaption, 4) = "fsub" Then pstrNewCtlName = strPrefix & _ Mid(StripChars(strCaption), 5)

Else pstrNewCtlName = strPrefix & _ StripChars(strCaption)

End If

Elself strCaption = "" Then

If Left(pstrOldCtlName, 3) = "frm" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrOldCtlName), 4) ElseIf Left(pstrOldCtlName, 4) = "fsub" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrOldCtlName), 5)

Else pstrNewCtlName = strPrefix & _ StripChars(pstrOldCtlName)

End If End If

If Right(pstrNewCtlName, 12) = "SubformLabel" Then pstrNewCtlName = Left(pstrNewCtlName, _ Len(pstrNewCtlName) - 12)

Elself Right(pstrNewCtlName, 5) = "Label" Then pstrNewCtlName = Left(pstrNewCtlName, _ Len(pstrNewCtlName) - 5)

End If pintRenameFail = True Do While pintRenameFail pintRenameFail = False pintReturn = MsgBox("Rename " _

& DLookup("[ControlTypeName]", _ "zLNCtblControlType", "[ControlType] = " _ & ctl.ControlType) _

& " control currently named " & pstrOldCtlName _ & vbCrLf & "(caption: " & strCaption & ") to" _ & vbCrLf & pstrNewCtlName & "?", vbYesNo + _ vbQuestion + vbDefaultButtonl, "Rename control") If pintReturn = vbYes Then

If blnTag = True Then ctl.Tag = ctl.ControlName ctl.ControlName = pstrNewCtlName ElseIf pintReturn = vbNo Then pstrNewCtlName = _

InputBox("Modify new control name", _ "Rename control", pstrNewCtlName) ctl.ControlName = pstrNewCtlName End If Loop

ErrorHandlerExit: Exit Function

ErrorHandler:

If the proposed control name is already in use, return to the renaming dialog.

pintRenameFail = True If Err.Number = 2104 Then

MsgBox "There is another control named " & _ pstrNewCtlName & "; please try again", , _ "Control Name Used" pstrNewCtlName = pstrNewCtlName & "1" Else

AddInErr Err Resume ErrorHandlerExit End If

Resume Next

End Function

Public Function ControlSO(ctl As Access.Control, _ strPrefix As String, blnTag As Boolean) As Integer

Does group renaming of all controls with source objects on a form or report.

'Called from RenameFormControls and RenameReportControls 'in this module

On Error GoTo ErrorHandler pstrOldCtlName = ctl.ControlName pstrSourceObject = Nz(ctl.SourceObject)

If Left(pstrOldCtlName, 3) = strPrefix Then

Exit Function Elself pstrSourceObject <> "" Then

If Left(pstrSourceObject, 3) = "frm" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrSourceObject), 4) Elself Left(pstrSourceObject, 4) = "fsub" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrSourceObject), 5)

Else pstrNewCtlName = strPrefix & _ StripChars(pstrSourceObject)

End If

Elself pstrSourceObject = "" Then

If Left(pstrOldCtlName, 3) = "frm" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrOldCtlName), 4) Elself Left(pstrOldCtlName, 4) = "fsub" Then pstrNewCtlName = strPrefix & _

Mid(StripChars(pstrOldCtlName), 5)

Else pstrNewCtlName = strPrefix & _ StripChars(pstrOldCtlName)

End If Else pstrNewCtlName = strPrefix & _ StripChars(pstrOldCtlName)

End If

If Right(pstrNewCtlName, 7) = "Subform" Then pstrNewCtlName = Left(pstrNewCtlName, _ Len(pstrNewCtlName) - 7)

End If pintRenameFail = True Do While pintRenameFail pintRenameFail = False pintReturn = MsgBox("Rename " _

& DLookup("[ControlTypeName]", _ "zLNCtblControlType", "[ControlType] = " _

& ctl.ControlType) _

& " control currently named " & pstrOldCtlName _ & vbCrLf & "(source object: " & pstrSourceObject _ & ") to" & vbCrLf & pstrNewCtlName & "?", vbYesNo + vbQuestion + vbDefaultButtoni, "Rename control") If pintReturn = vbYes Then

If blnTag = True Then ctl.Tag = ctl.ControlName ctl.ControlName = pstrNewCtlName Elself pintReturn = vbNo Then pstrNewCtlName = _

InputBox("Modify new control name", _ "Rename control", pstrNewCtlName) ctl.ControlName = pstrNewCtlName End If Loop

ErrorHandlerExit: Exit Function

ErrorHandler:

If the proposed control name is already in use, return to the renaming dialog.

pintRenameFail = True If Err.Number = 2104 Then

MsgBox "There is another control named " & _ pstrNewCtlName & "; please try again", , _ "Control Name Used" pstrNewCtlName = pstrNewCtlName & "1" Else

AddInErr Err Resume ErrorHandlerExit End If

Resume ErrorHandlerExit

End Function

Public Function ControlNA(ctl As Access.Control, _ strPrefix As String, blnTag As Boolean) As Integer

Does group renaming of all controls not fitting the other categories on a form or report.

'Called from RenameFormControls and RenameReportControls 'in this module

On Error GoTo ErrorHandler pstrOldCtlName = ctl.ControlName

Special case for lines whose default name is "Line" or "Option" (same first three letters as the standard prefix).

If Left(pstrOldCtlName, 3) = strPrefix And _ Left(pstrOldCtlName, 6) <> "Option" And _ Left(pstrOldCtlName, 4) <> "Line" Then Exit Function Else pstrNewCtlName = strPrefix _ & StripChars(pstrOldCtlName)

End If pintRenameFail = True Do While pintRenameFail pintRenameFail = False pintReturn = MsgBox("Rename " & _ DLookup("[ControlTypeName]", _ "zLNCtblControlType", "[ControlType] = " _ & ctl.ControlType) & " control currently named " _ & pstrOldCtlName & " to" & vbCrLf _ & pstrNewCtlName & "?", vbYesNo + vbQuestion _ + vbDefaultButtoni, _ "Rename control") If pintReturn = vbYes Then

If blnTag = True Then ctl.Tag = ctl.ControlName ctl.ControlName = pstrNewCtlName ElseIf pintReturn = vbNo Then pstrNewCtlName = _

InputBox("Modify new control name", _ "Rename control", pstrNewCtlName) ctl.ControlName = pstrNewCtlName End If Loop

ErrorHandlerExit: Exit Function

ErrorHandler:

If the proposed control name is already in use, return to the renaming dialog.

pintRenameFail = True If Err.Number = 2104 Then

MsgBox "There is another control named " & _ pstrNewCtlName & "; please try again", , _ "Control Name Used" pstrNewCtlName = pstrNewCtlName & "1" Else

AddInErr Err

End If

Resume ErrorHandlerExit

End Function

Public Function CreateCTTable() 'Called from LNCRenameFormControls and 'LNCRenameReportControls function 'in this module

Dim strCTTable As String strCTTable = "zLNCtblControlType"

Delete the old table, if there is one.

Set pdbs = CurrentDb strCTTable = "zLNCtblControlType" On Error Resume Next pdbs.TableDefs.Delete strCTTable

On Error GoTo ErrorHandler

Generate the table of control types to use in renaming controls. If there is a "table not found" error, exit function.

pstrSQL = "CREATE TABLE " & strCTTable & _

"(ControlType LONG, ControlTypeName TEXT (50));" DoCmd.RunSQL pstrSQL

Append data to the table of control types. Set pdbs = CurrentDb

Set prst = pdbs.OpenRecordset(strCTTable, dbOpenTable) With prst .AddNew

!ControlType = 100 !ControlTypeName = "Label" .Update .AddNew

!ControlType = 101 !ControlTypeName = "Rectangle" .Update .AddNew

!ControlType = 102 !ControlTypeName = "Line" .Update .AddNew

IControlType = 1C3 !ControlTypeName = .Update .AddNew

IControlType = 1C4 IControlTypeName = .Update .AddNew

IControlType = 1C5 IControlTypeName = .Update .AddNew

IControlType = 1C6 IControlTypeName = .Update .AddNew

IControlType = 1C7 IControlTypeName = .Update .AddNew

IControlType = 1C8 IControlTypeName = .Update .AddNew

IControlType = 1C9 IControlTypeName = .Update .AddNew

IControlType = 11C IControlTypeName = .Update .AddNew

IControlType = 111 IControlTypeName = .Update .AddNew

IControlType = 112 IControlTypeName = .Update .AddNew

IControlType = 114 IControlTypeName = .Update .AddNew

IControlType = 118 IControlTypeName = .Update .AddNew

"Image"

"Command Button"

"Option Button"

"Check Box"

"Option Group"

"Bound Object Frame"

"Text Box"

"List Box"

"Combo Box"

"Subform/Subreport"

"Object Frame"

"Page Break"

!ControlType = 122

!ControlTypeName = "Toggle Button"

.Update

.AddNew

!ControlType = 123 !ControlTypeName = "Tab Control" .Update .AddNew

!ControlType = 124 !ControlTypeName = "Page" .Update .Close End With

ErrorHandlerExit: Exit Function

ErrorHandler:

If Err.Number = 3 010 Then

Control types table already exists.

Exit Function Else

AddInErr Err Resume ErrorHandlerExit End If

End Function

Creating the DLL

After modifying the code in the SharedCode and AccessDesigner modules as needed, save the project with a meaningful name (I named the sample COM add-in "LNC Control Renaming"). The project name will also be used as the name of the DLL file when you make that file. The final step is creating the add-in's DLL by selecting File, Make Project Name.dll (with the actual project name replacing the "Project Name"). If there are any syntax errors in the project, you will get an error message at this point, and you can correct the errors and try again, until the DLL is successfully created.

To rename a VB project, select the project (the top line in the Project Explorer) and modify its name property in the properties sheet. To modify a Designer's name, open it, and modify its name in the properties sheet. The name you give a VB project is the one that will be used by default when creating a DLL.

0 0

Post a comment