Creating COM Add-Ins

3 4

COM add-ins were introduced in Office 2000; they significantly extend the functionality of add-ins because they’re available to all Office applications and can also be run from the VBE window. A COM add-in is a dynamic-link library (DLL) that’s registered so that it works with Office applications (or, in some cases, an ActiveX EXE file). You can create COM add-ins using Microsoft Visual C++, Microsoft Visual J++, Visual Microsoft Basic 5.0 or later, or VBA 6.0 or later. To create a COM add-in with VBA, you need MOD, which includes the special tools you need to create these add-ins.

With a COM add-in, there’s no USysRegInfo table and no add-in database. Instead, you create a VBA project (VBA file), and when the project is complete, you create a DLL file, which is placed in the add-ins folder and installed by means of the COM Add-Ins menu (not the regular Add-Ins menu). COM add-ins can create menu commands (on any menu) and toolbar buttons, which gives them more flexibility than regular Access add-ins.

The COM Add-Ins menu isn’t displayed by default; to make it visible, open the Customize dialog box by right-clicking on the gray background of a toolbar. Locate COM Add-Ins at the bottom of the list of commands in the Tools category on the Commands tab (as shown in Figure 21-27), and drag it to the desired toolbar location.

figure 21-27. you can find the com add-ins selection in the customize dialog box.

Figure 21-27. You can find the COM Add-Ins selection in the Customize dialog box.

Creating the LNC Rename COM Add-In

Unlike with regular add-ins, you can’t write COM add-ins in the regular version of Access—you must have Office XP Developer or another programming language that supports creating COM add-ins, such as Visual Basic or Visual C++. Creating COM add-ins in VBA is slightly different from creating them in Visual Basic, so some of the screen shots and code might differ between the two. This section describes creating COM add-ins in VBA, using the tools that are part of Office XP Developer.

If you have Office XP Developer installed, switch to the Visual Basic Editor and choose File, New Project. Select Add-In Project in the New Project dialog box, as shown in Figure 21-28.

figure 21-28. you create a new com add-in project by selecting add-in project in the new project dialog box.

Figure 21-28. You create a new COM add-in project by selecting Add-In Project in the New Project dialog box.

The new COM add-in project is initially called AddInProject1, but you can rename it to something more meaningful. Under the new project is a Designers folder, with a new designer, named AddInDesigner1 by default. If you’re writing a COM add-in for multiple Office applications, you need a designer for each one because designers are application- and version-specific.

Renaming a Project

To rename the project (or designer), highlight its Name property in the project (or designer) properties sheet and modify it as desired, as shown in Figure 21-29. Project and designer names can’t contain spaces, and it’s best to stick with all-alphanumeric names.

figure 21-29. you can give a project a more meaningful name in its properties sheet.

Figure 21-29. You can give a project a more meaningful name in its properties sheet.

The new designer’s properties sheet is then displayed; you can fill it in with general project information. (Figure 21-30 shows the properties sheet filled in for the LNC Rename COM add-in project.) The Addin Display Name property is the name of the COM add-in as displayed in the COM Add-Ins dialog box (the dialog box that appears when you click the COM Add-Ins toolbar button or menu command). The Addin Description property gives more information about the COM add-in’s functionality. Curiously, the description isn’t visible in the COM Add-Ins dialog box, but you can read it using the COMAddIn object’s Description property in VBA.

figure 21-30. you can use the lnc rename com add-in project designer’s properties sheet to specify some of its properties.

Figure 21-30. You can use the LNC Rename COM Add-In project designer’s properties sheet to specify some of its properties.

In the Application drop-down list, you can select the Office application in which the COM add-in will run. In the Application Version drop-down list, you can select the version of that application. It doesn’t offer a choice, however—only the current version is available for selection. The Initial Load Behavior drop-down list offers several alternatives for loading the COM add-in; the Startup option is generally the most useful. A final properties sheet selection, Add-In Is Command-Line Safe (does not put up any UI) isn’t relevant to Office add-ins; it will disappear from the properties sheet after an Office application is selected.

After you fill in the properties sheet, you can save the project. The proposed save name will be AddInProject1.vba even if you gave the project a more meaningful name. You should override the suggested file name with a more meaningful name, which will then be the suggested save name for the DLL you create later on.

The next step is to create the code (and possibly a form) for the COM add-in. Although you use a different process for creating the COM add-in than for a regular Access add-in and the interface is also different, the core code can be the same, so I decided to recycle some of the code I used in my LNC Rename add-in for a COM add-in to rename controls on forms and reports.

As you’ll recall, the LNC Rename Access add-in consists of several menu add-ins and two Property Builders. For the COM add-in, I decided to create a set of toolbar buttons to rename controls on all open forms or all open reports (an option between the Access menu add-ins that rename all form or report controls and the Property Builder that renames all controls on just the current form or report).

The designer has its own class module, which is accessible through the View Code command on the designer’s shortcut menu. To work with the host application, the COM add-in works with events that fire when the add-in is loaded or unloaded or when the host application starts or shuts down. These events are implemented via the IDTExtensibility2 library within the designer’s class module. To implement this functionality, you add the following line to the Declarations section of the designer’s class module:

 Implements IDTExtensibility2 

After you add this line, you can select the IDTExtensibility2 library in the Object box in the VBE window and then select the five event procedures in the Procedure box, creating code stubs for each event. The designer’s class module must have code stubs for all five procedures, even if you don’t need code in all of them. You can put a comment in the procedures that don’t need functional code.

COM add-ins are typically implemented as toolbar buttons or menu commands that can be placed on any toolbar or menu in the host application. If you’re going to use a toolbar button or menu command as the COM add-in’s interface, you must also add two (or more) statements to the module’s Declarations section. Specifically, you need to declare one or more CommandBarButton objects using the WithEvents keyword so that you can write code for their Click event(s).

Because a designer is application-specific, any code that applies specifically to an individual Office application should be located in the designer class module; code that applies to all Office applications should be located in a standard module so that it can be called from any or all designers. The AccessDesigner module code is shown here. This code contains the IDTExtensibility2 event procedures, the functions to create (and re

 Implements IDTExtensibility2 Private WithEvents pctlFormButton As Office.CommandBarButton Private WithEvents pctlReportButton As Office.CommandBarButton 'Global variable to store reference to host application Public gobjAppInstance As Object 'Regular variables for creating toolbar buttons Dim cbrMenu As Office.CommandBar Dim ctlBtnAddIn As Office.CommandBarButton 'Global variables for handling renaming Public gctl As Access.Control Public gdbs As DAO.Database Public gfrm As Access.Form Public gintRenameFail As Integer Public gintReturn As Integer Public glngControlType As Long Public grpt As Access.Report Public grst As DAO.Recordset Public gstrMessage As String Public gstrNewCtlName As String Public gstrOldCtlName As String Public gstrSQL As String Public gstrSourceObject As String 'Regular variables for handling renaming Dim i As Integer Dim blnTag As Boolean Dim intTag As Integer Dim strPrefix As String Dim blnUnbound As Boolean Dim strControlSource As String Dim strCaption As String Dim strObjectName As String Dim strCtlName As String 'Constants for characters surrounding ProgID Const PROG_ID_START As String = "!<" Const PROG_ID_END As String = ">" Sub AddInErr(errX As ErrObject) 'Displays message box with error information    Dim strMsg As String        strMsg = "An error occurred in the LNC " _        & "Renaming COM add-in " _        & vbCrLf & "Error #:" & errX.Number _        & vbCrLf & "Description: " & errX.Description    MsgBox strMsg, , "Error!" End Sub 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 pctlFormButton = CreateFormCommandBarButton _             (Application, ConnectMode, AddInInst)    Set pctlReportButton = CreateReportCommandBarButton _             (Application, ConnectMode, AddInInst)     ErrorHandlerExit:    Exit Sub ErrorHandler:    AddInErr 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:    AddInErr Err    Resume ErrorHandlerExit End Sub Private Sub pctlFormButton_Click(ByVal ctl As _    Office.CommandBarButton, CancelDefault As Boolean)    Call LNCRenameFormControls End Sub Private Sub pctlReportButton_Click(ByVal ctl As _    Office.CommandBarButton, CancelDefault As Boolean)    Call LNCRenameReportControls     End Sub Public Function CreateFormCommandBarButton _    (ByVal Application As Object, _    ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _    ByVal AddInInst As Object) As Office.CommandBarButton On Error GoTo ErrorHandler    'Store reference to Application object in a public variable    'so that other procedures in the add-in can use it.    Set gobjAppInstance = Application    'Return reference to command bar.    Set cbrMenu = gobjAppInstance.CommandBars("Form Design")    'Add button to call add-in from command bar, if it doesn’t    'already exist.    'Look for button on command bar.    Set ctlBtnAddIn = cbrMenu.FindControl _       (Tag:="Rename Form Controls")    If ctlBtnAddIn Is Nothing Then       'Add new button.       Set ctlBtnAddIn = _       cbrMenu.Controls.Add(Type:=msoControlButton, _       Parameter:="Rename Form Controls")       'Set button’s Caption, Tag, Style,        'and OnAction properties.       With ctlBtnAddIn          Caption = "&Rename Controls"          .Tag = "Rename Form Controls"          .Style = msoButtonCaption          'Run main add-in function.          .OnAction = PROG_ID_START & AddInInst.ProgId _             & PROG_ID_END       End With    End If    'Return reference to new command bar buttons.    Set CreateFormCommandBarButton = ctlBtnAddIn 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 reference to Application object in a public variable    'so that other procedures in the add-in can use it.    Set gobjAppInstance = Application            'Return reference to command bar.     Set cbrMenu = gobjAppInstance.CommandBars("Report Design")          'Add button to call add-in from command bar, if it doesn’t     'already exist.     'Look for button on command bar.     Set ctlBtnAddIn = cbrMenu.FindControl _                     (Tag:="Rename Report Controls")     If ctlBtnAddIn Is Nothing Then         'Add new button.         Set ctlBtnAddIn = cbrMenu.Controls.Add _            (Type:=msoControlButton, _             Parameter:="Rename Report Controls")         'Set button’s Caption, Tag, Style,          'and OnAction properties.         With ctlBtnAddIn             .Caption = "&Rename Controls"             .Tag = "Rename Report Controls"             .Style = msoButtonCaption             'Run main add-in function             .OnAction = PROG_ID_START & AddInInst.ProgId _                 & PROG_ID_END         End With     End If          'Return reference to new command bar button.     Set CreateReportCommandBarButton = ctlBtnAddIn     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 GoTo ErrorHandler     'If user unloaded add-in, remove button.      'Otherwise, add-in is being unloaded because      'application is closing; in that case,     'leave button as is.     If RemoveMode = ext_dm_UserClosed Then         On Error Resume Next         'Delete custom command bar button.         gobjAppInstance.CommandBars("Form Design").Controls _             ("Rename Form Controls").Delete         gobjAppInstance.CommandBars("Report Design").Controls _             ("Rename Report Controls").Delete         On Error GoTo ErrorHandlerExit     End If ErrorHandlerExit:    Exit Function ErrorHandler:    AddInErr Err    Resume ErrorHandlerExit     End Function Public Function LNCRenameFormControls() As Variant 'Renames all the controls on open forms    'Generate table of control types to use in renaming controls    '(if it doesn’t already exist).    CreateCTTable     On Error GoTo ErrorHandler    'Determine whether any forms are open, and exit if not.    If Forms.Count = 0 Then       MsgBox "No forms are open; exiting"       GoTo ErrorHandlerExit    End If        'Determine whether original control names     'should be stored in Tag property.    gstrMessage = "When form processing controls, " _           & "should the original control name be saved to " _           & "the control’s Tag property?"    intTag = MsgBox(gstrMessage, vbYesNo + vbQuestion + _       vbDefaultButton2, "Control Name Backup")        If intTag = vbYes Then       blnTag = True    Else       blnTag = False    End If        'Process open forms.    For Each gfrm In Forms           For Each gctl In gfrm.Controls          strCtlName = gctl.Name          glngControlType = gctl.ControlType          blnUnbound = False                    Select Case glngControlType             'Controls with control source             Case acTextBox                strPrefix = "txt"                i = ControlCS(gctl, strPrefix, blnTag)                          Case acComboBox                strPrefix = "cbo"                i = ControlCS(gctl, strPrefix, blnTag)                 Case acCheckBox                strPrefix = "chk"                strControlSource = gctl.ControlSource                If blnUnbound = False Then                   i = ControlCS(gctl, strPrefix, blnTag)                Else                   i = ControlNA(gctl, strPrefix, blnTag)                End If                             Case acBoundObjectFrame                strPrefix = "frb"                i = ControlCS(gctl, strPrefix, blnTag)                 Case acListBox                strPrefix = "lst"                i = ControlCS(gctl, strPrefix, blnTag)                         Case acOptionGroup                strPrefix = "fra"                i = ControlCS(gctl, strPrefix, blnTag)                          Case acOptionButton                strPrefix = "opt"                strControlSource = gctl.ControlSource                If blnUnbound = False Then                   i = ControlCS(gctl, strPrefix, blnTag)                Else                   i = ControlNA(gctl, strPrefix, blnTag)                End If                 'Controls with caption only             Case acToggleButton                strPrefix = "tgl"                i = ControlCA(gctl, strPrefix, blnTag)                             Case acLabel                strPrefix = "lbl"                i = ControlCA(gctl, strPrefix, blnTag)                             Case acCommandButton                strPrefix = "cmd"                i = ControlCA(gctl, strPrefix, blnTag)                          'Controls with source object only             Case acSubform                strPrefix = "sub"                i = ControlSO(gctl, strPrefix, blnTag)                 'Controls with none of the above             Case acObjectFrame                strPrefix = "fru"                i = ControlNA(gctl, strPrefix, blnTag)                             Case acImage                strPrefix = "img"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acTabCtl                strPrefix = "tab"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acLine                strPrefix = "lin"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acPage                strPrefix = "pge"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acPageBreak                strPrefix = "brk"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acRectangle                strPrefix = "shp"                i = ControlNA(gctl, strPrefix, blnTag)                       End Select       Next gctl    Next gfrm    Call MsgBox("All form controls renamed!", vbOKOnly, "Done")     ErrorHandlerExit:    Exit Function ErrorHandler:    'If an option button or a check box is unbound, set    'blnUnbound to True so that the code uses the NA function instead of CS.    If Err.Number = 2455 Then       blnUnbound = True       Resume Next    Else       AddInErr Err       Resume ErrorHandlerExit    End If End Function Public Function LNCRenameReportControls() As Variant 'Renames all the controls on open reports    'Generate table of control types to use in renaming controls    '(if it doesn’t already exist).    CreateCTTable     On Error GoTo ErrorHandler    'Determine whether any reports are open, and exit if not.    If Reports.Count = 0 Then       MsgBox "No reports are open; exiting"       GoTo ErrorHandlerExit    End If        'Determine whether original control names     'should be stored in Tag property.    gstrMessage = "When processing report controls, should " _         & "the  original control name be saved to the " _         & "control’s Tag property?"    intTag = MsgBox(gstrMessage, vbYesNo + vbQuestion + _       vbDefaultButton2, "Control Name Backup")        If intTag = vbYes Then       blnTag = True    Else       blnTag = False    End If        'Process open reports.    For Each grpt In Reports           For Each gctl In grpt.Controls          strCtlName = gctl.Name          glngControlType = gctl.ControlType          blnUnbound = False                    Select Case glngControlType             'Controls with control source             Case acTextBox                strPrefix = "txt"                i = ControlCS(gctl, strPrefix, blnTag)                          Case acComboBox                strPrefix = "cbo"                i = ControlCS(gctl, strPrefix, blnTag)                 Case acCheckBox                strPrefix = "chk"                strControlSource = gctl.ControlSource                If blnUnbound = False Then                   i = ControlCS(gctl, strPrefix, blnTag)                Else                   i = ControlNA(gctl, strPrefix, blnTag)                End If                             Case acBoundObjectFrame                strPrefix = "frb"                i = ControlCS(gctl, strPrefix, blnTag)                 Case acListBox                strPrefix = "lst"                i = ControlCS(gctl, strPrefix, blnTag)                         Case acOptionGroup                strPrefix = "fra"                i = ControlCS(gctl, strPrefix, blnTag)                          Case acOptionButton                strPrefix = "opt"                strControlSource = gctl.ControlSource                If blnUnbound = False Then                   i = ControlCS(gctl, strPrefix, blnTag)                Else                   i = ControlNA(gctl, strPrefix, blnTag)                End If                 'Controls with caption only             Case acToggleButton                strPrefix = "tgl"                i = ControlCA(gctl, strPrefix, blnTag)                             Case acLabel                strPrefix = "lbl"                i = ControlCA(gctl, strPrefix, blnTag)                             Case acCommandButton                strPrefix = "cmd"                i = ControlCA(gctl, strPrefix, blnTag)                          'Controls with source object only             Case acSubform                strPrefix = "sub"                i = ControlSO(gctl, strPrefix, blnTag)                 'Controls with none of the above             Case acObjectFrame                strPrefix = "fru"                i = ControlNA(gctl, strPrefix, blnTag)                             Case acImage                strPrefix = "img"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acTabCtl                strPrefix = "tab"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acLine                strPrefix = "lin"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acPage                strPrefix = "pge"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acPageBreak                strPrefix = "brk"                i = ControlNA(gctl, strPrefix, blnTag)                          Case acRectangle                strPrefix = "shp"                i = ControlNA(gctl, strPrefix, blnTag)                       End Select       Next gctl    Next grpt    Call MsgBox("All report controls renamed!", _                vbOKOnly, "Done")     ErrorHandlerExit:    Exit Function ErrorHandler:    'If an option button or a check box is unbound, set    'blnUnbound to True so that the code uses the NA     'function instead of CS.    If Err.Number = 2455 Then       blnUnbound = True       Resume Next    Else       AddInErr Err       Resume ErrorHandlerExit     End If End Function Public Function ControlCS(ctl As 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)    gstrOldCtlName = ctl.ControlName        'Check whether control is already correctly     'named and also special case for    'controls whose original name starts     'with "Option" or "Frame"    '(same first three letters as prefix).    If Left(gstrOldCtlName, 3) = strPrefix And _       Left(gstrOldCtlName, 6) _       <> "Option" And Left(gstrOldCtlName, 3) = strPrefix And _       Left(gstrOldCtlName, 5) <> "Frame" Then       Exit Function           'If the control source isn’t empty, use it.    ElseIf strControlSource <> "" Then       gstrNewCtlName = strPrefix & _         StripNonAlphaNumericChars(strControlSource)    'Otherwise, use the original control name.    Else       gstrNewCtlName = strPrefix & _         StripNonAlphaNumericChars(gstrOldCtlName)    End If           'Fix name of "Page x of y" text box controls     'on Database Wizard reports.    If gstrNewCtlName = "txtPagePageofPages" Then       gstrNewCtlName = "txtPages"    End If        'Show the user    '  - the original control name    '  - the control type    '  - the control source    '  - the proposed new name    'and ask whether the new name is acceptable.    gintRenameFail = True    Do While gintRenameFail       gintRenameFail = False       gintReturn = MsgBox( _           "Rename " & _           DLookup("[ControlTypeName]", "zLNCtblControlType", _           "[ControlType] = " & ctl.ControlType) _           & " control currently named " _           & gstrOldCtlName & vbCrLf & _           "(control source: " & strControlSource & ") " & _           "to" & vbCrLf & gstrNewCtlName & "?", _           vbYesNo + vbQuestion + vbDefaultButton1, _           "Rename control")              'If the user clicks the Yes button, rename the control.       If gintReturn = vbYes Then          If blnTag = True Then             ctl.Tag = ctl.ControlName          End If          ctl.ControlName = gstrNewCtlName                    'Otherwise, display an input box for editing the name.       ElseIf gintReturn = vbNo Then          gstrNewCtlName = _             InputBox("Modify new control name", _             "Rename control", gstrNewCtlName)             ctl.ControlName = gstrNewCtlName       End If    Loop     ErrorHandlerExit:    Exit Function     ErrorHandler:    'If the proposed control name is already in use,    'return to the renaming dialog box.    gintRenameFail = True    If Err.Number = 2104 Then       MsgBox "There is another control named " & _          gstrNewCtlName & "; please try again", , _          "Control Name Used"       gstrNewCtlName = gstrNewCtlName & "1"    Else       AddInErr Err       Resume ErrorHandlerExit    End If        Resume Next End Function Public Function ControlCA(ctl As 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        gstrOldCtlName = ctl.ControlName    strCaption = ctl.Caption        If Left(gstrOldCtlName, 3) = strPrefix Then       Exit Function    ElseIf strCaption <> "" Then       If Left(strCaption, 3) = "frm" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(strCaption), 4)       ElseIf Left(strCaption, 4) = "fsub" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(strCaption), 5)       Else          gstrNewCtlName = strPrefix & _             StripNonAlphaNumericChars(strCaption)       End If    ElseIf strCaption = "" Then       If Left(gstrOldCtlName, 3) = "frm" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrOldCtlName), 4)       ElseIf Left(gstrOldCtlName, 4) = "fsub" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrOldCtlName), 5)       Else          gstrNewCtlName = strPrefix & _             StripNonAlphaNumericChars(gstrOldCtlName)       End If    End If        If Right(gstrNewCtlName, 12) = "SubformLabel" Then       gstrNewCtlName = Left(gstrNewCtlName, _             Len(gstrNewCtlName) - 12)    ElseIf Right(gstrNewCtlName, 5) = "Label" Then       gstrNewCtlName = Left(gstrNewCtlName, _             Len(gstrNewCtlName) - 5)    End If        gintRenameFail = True    Do While gintRenameFail       gintRenameFail = False       gintReturn = MsgBox("Rename " _          & DLookup("[ControlTypeName]", _          "zLNCtblControlType", "[ControlType] = " _          & ctl.ControlType) _          & " control currently named " & gstrOldCtlName _          & vbCrLf & _          "(caption: " & strCaption & ") to" & vbCrLf & _          gstrNewCtlName & "?", vbYesNo + vbQuestion + _          vbDefaultButton1, "Rename control")       If gintReturn = vbYes Then          If blnTag = True Then ctl.Tag = ctl.ControlName          ctl.ControlName = gstrNewCtlName       ElseIf gintReturn = vbNo Then          gstrNewCtlName = InputBox("Modify new control name", _             "Rename control", gstrNewCtlName)          ctl.ControlName = gstrNewCtlName       End If    Loop     ErrorHandlerExit:    Exit Function ErrorHandler:    'If the proposed control name is already in use,    'return to the renaming dialog box.    gintRenameFail = True    If Err.Number = 2104 Then       MsgBox "There is another control named " & _          gstrNewCtlName & "; please try again", , _          "Control Name Used"       gstrNewCtlName = gstrNewCtlName & "1"    Else       AddInErr Err       Resume ErrorHandlerExit    End If        Resume Next End Function Public Function ControlSO(ctl As 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    gstrOldCtlName = ctl.ControlName    gstrSourceObject = Nz(ctl.SourceObject)    If Left(gstrOldCtlName, 3) = strPrefix Then       Exit Function    ElseIf gstrSourceObject <> "" Then       If Left(gstrSourceObject, 3) = "frm" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrSourceObject), 4)       ElseIf Left(gstrSourceObject, 4) = "fsub" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrSourceObject), 5)       Else          gstrNewCtlName = strPrefix & _             StripNonAlphaNumericChars(gstrSourceObject)       End If    ElseIf gstrSourceObject = "" Then       If Left(gstrOldCtlName, 3) = "frm" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrOldCtlName), 4)       ElseIf Left(gstrOldCtlName, 4) = "fsub" Then          gstrNewCtlName = strPrefix & _             Mid(StripNonAlphaNumericChars(gstrOldCtlName), 5)       Else          gstrNewCtlName = strPrefix & _             StripNonAlphaNumericChars(gstrOldCtlName)       End If    Else       gstrNewCtlName = strPrefix & _          StripNonAlphaNumericChars(gstrOldCtlName)    End If        If Right(gstrNewCtlName, 7) = "Subform" Then       gstrNewCtlName = Left(gstrNewCtlName, _             Len(gstrNewCtlName) - 7)    End If        gintRenameFail = True    Do While gintRenameFail       gintRenameFail = False       gintReturn = MsgBox("Rename " & _          DLookup("[ControlTypeName]", _          "zLNCtblControlType", "[ControlType] = " & _          ctl.ControlType) _          & " control currently named " & _          gstrOldCtlName & vbCrLf & _          "(source object: " & gstrSourceObject & ") to" _          & vbCrLf & _          gstrNewCtlName & "?", vbYesNo + _          vbQuestion + vbDefaultButton1, _          "Rename control")       If gintReturn = vbYes Then          If blnTag = True Then ctl.Tag = ctl.ControlName          ctl.ControlName = gstrNewCtlName       ElseIf gintReturn = vbNo Then          gstrNewCtlName = InputBox("Modify new control name", _             "Rename control", gstrNewCtlName)          ctl.ControlName = gstrNewCtlName       End If    Loop     ErrorHandlerExit:    Exit Function ErrorHandler:    'If the proposed control name is already in use,    'return to the renaming dialog box.    gintRenameFail = True    If Err.Number = 2104 Then       MsgBox "There is another control named " & _          gstrNewCtlName & "; please try again", , _          "Control Name Used"       gstrNewCtlName = gstrNewCtlName & "1"    Else       AddInErr Err       Resume ErrorHandlerExit    End If    Resume ErrorHandlerExit End Function Public Function ControlNA(ctl As Control, _    strPrefix As String, blnTag As Boolean) As Integer 'Called from RenameFormControls and RenameReportControls  'in this module 'Does group renaming of all controls not fitting the 'other categories on a form or report On Error GoTo ErrorHandler        gstrOldCtlName = ctl.ControlName        'Special case for lines whose default name is "Line"    'or "Option" (same first three letters     'as the standard prefix)    If Left(gstrOldCtlName, 3) = strPrefix And _       Left(gstrOldCtlName, 6) <> "Option" And _       Left(gstrOldCtlName, 4) <> "Line" Then       Exit Function    Else       gstrNewCtlName = strPrefix & _           StripNonAlphaNumericChars(gstrOldCtlName)    End If        gintRenameFail = True    Do While gintRenameFail       gintRenameFail = False       gintReturn = MsgBox("Rename " & _          DLookup("[ControlTypeName]", _          "zLNCtblControlType", "[ControlType] = " & _          ctl.ControlType) & _          " control currently named " & gstrOldCtlName _          & " to" & vbCrLf _          & gstrNewCtlName & "?", _          vbYesNo + vbQuestion + vbDefaultButton1, _          "Rename control")       If gintReturn = vbYes Then          If blnTag = True Then ctl.Tag = ctl.ControlName          ctl.ControlName = gstrNewCtlName       ElseIf gintReturn = vbNo Then          gstrNewCtlName = InputBox("Modify new control name", _             "Rename control", gstrNewCtlName)          ctl.ControlName = gstrNewCtlName       End If    Loop     ErrorHandlerExit:    Exit Function ErrorHandler:    'If the proposed control name is already in use,    'return to the renaming dialog box.    gintRenameFail = True    If Err.Number = 2104 Then       MsgBox "There is another control named " & _          gstrNewCtlName & "; please try again", , _          "Control Name Used"       gstrNewCtlName = gstrNewCtlName & "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 old table, if there is one.    Set gdbs = CurrentDb    strCTTable = "zLNCtblControlType"    On Error Resume Next    gdbs.TableDefs.Delete strCTTable On Error GoTo ErrorHandler    'Generate table of control types to use     'in renaming controls.    'If there is a "table not found" error, exit function.    gstrSQL = "CREATE TABLE " & strCTTable & _       "(ControlType LONG, ControlTypeName TEXT (50));"    DoCmd.RunSQL gstrSQL        'Append data to table of control types.    Set gdbs = CurrentDb    Set grst = gdbs.OpenRecordset(strCTTable, dbOpenTable)    With grst       .AddNew       !ControlType = 100       !ControlTypeName = "Label"       .Update       .AddNew       !ControlType = 101       !ControlTypeName = "Rectangle"       .Update       .AddNew       !ControlType = 102       !ControlTypeName = "Line"       .Update       .AddNew       !ControlType = 103       !ControlTypeName = "Image"       .Update       .AddNew       !ControlType = 104       !ControlTypeName = "Command Button"       .Update       .AddNew       !ControlType = 105       !ControlTypeName = "Option Button"       .Update       .AddNew       !ControlType = 106       !ControlTypeName = "Check Box"       .Update       .AddNew       !ControlType = 107       !ControlTypeName = "Option Group"       .Update       .AddNew       !ControlType = 108       !ControlTypeName = "Bound Object Frame"       .Update       .AddNew       !ControlType = 109       !ControlTypeName = "Text Box"       .Update       .AddNew       !ControlType = 110       !ControlTypeName = "List Box"       .Update       .AddNew       !ControlType = 111       !ControlTypeName = "Combo Box"       .Update       .AddNew       !ControlType = 112       !ControlTypeName = "Subform/Subreport"       .Update       .AddNew       !ControlType = 114       !ControlTypeName = "Object Frame"       .Update       .AddNew       !ControlType = 118       !ControlTypeName = "Page Break"       .Update       .AddNew       !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 = 3010 Then       'Control types table already exists       Exit Function    Else       AddInErr Err       Resume ErrorHandlerExit    End If     End Function 

The Declarations section of this module declares two command bar buttons (pctlFormButton and pctlReportButton), using the WithEvents keyword. These buttons will be used to run the LNC Rename code for renaming form or report control buttons. The buttons are created on specific Access toolbars, so their code must be in the Designer module even though CommandBars and CommandBarButtons belong to the Office object model. The OnAddInsUpdate, OnBeginShutdown, and OnStartupComplete events don’t need any code in this add-in.

The Declarations section of this module also declares several groups of global and regular variables—a global variable to reference the host application, global variables to rename controls, regular variables for creating the toolbar buttons and for handling renaming, and two constants for the special characters needed to surround the ProgId used for setting the command bar buttons’ OnAction property.

The OnConnection event procedure sets the command bar button variables. It uses the CreateFormCommandBarButton and CreateReportCommandBarButton functions to create these buttons on the appropriate Access toolbars.

The OnDisconnection event procedure runs a function (also included in this module) to remove the two command bar buttons when the add-in is disconnected. The buttons aren’t removed when the host application is closed—only when the add-in is unloaded in the COM Add-Ins dialog box. The last two functions in this module are the Click event procedures for the two command bar buttons. They run the LNCRenameFormControls and LNCRenameReportControls functions, which rename form controls and report controls.

See Chapter 13, "Customizing Access Toolbars and Menus (Command Bars)," for more details on creating command bar buttons.

The module’s first procedure is a custom error handler function that’s called by the other functions in the module. After the IDTExtensibility2 event procedures, there are two Click event procedures to run the LNCRenameFormControls and LNCRenameReportsControls functions (also in this module).

The CreateFormCommandBarButton function creates the toolbar button for renaming controls on open forms. This function first sets the gobjAppInstance global variable to the Access Application object, and then it sets a reference to the Form Design toolbar (the toolbar where the button will be created). The code looks for the button on this toolbar (so as not to create a duplicate button) using its Tag property; if it doesn’t find the button, it creates one.

Normally, a command bar button’s OnAction property is set to the name of a macro (a Sub procedure with no arguments) that’s run when the button is clicked. However, for buttons used in COM add-ins, a special syntax is used, which sets the OnAction property to the ProgId of the COM add-in. (The button’s Click event is handled by the Click event procedure.)

note


ACOM add-in’s ProgID (programmatic identifier) is the subkey created for the add-in in the registry. It consists of the name of the project followed by the name of the designer, separated by a period.

The CreateReportCommandBarButton function is similar; it creates a button for the Report Design toolbar. The RemoveAddInCommandBarButton function removes the add-in’s command buttons; it’s called by the OnDisconnection event procedure.

The LNCRenameFormControls and LNCRenameReportControls functions are based on code used in the Access LNC Rename add-in, so I won’t address them in detail here. The significant differences are that each of these functions deals with one type of database object (forms or reports) and cycles through the open forms (or reports) only. (The Rename Form Controls and Rename Report Controls menu add-ins rename controls on all forms or reports, regardless of whether they’re open.) This provides an intermediate step between renaming controls on all forms (or reports) and renaming only the controls on the current form (or report). The user can open only the forms or reports that need their controls renamed and then click the Rename Controls button on the form or report design toolbar.

The LNCRenameFormControls and LNCRenameReportControls functions call the same functions for renaming of various controls that are used in the Access add-in.

Troubleshooting - When I try to compile my COM add-in, I get the message Compile error: User-defined type not defined

This error (which can occur in a regular Access database, an Access add-in, or a COM add-in) most likely results from a missing or wrong version reference. To fix the broken reference, follow these steps:

  1. If necessary, reset the code by clicking the Reset button or by choosing Run, Reset.
  2. Uninstall the add-in from the Add-Ins (or COM Add-Ins) dialog box in an Access database.
  3. Close the database.
  4. Open the add-in (if it’s an Access add-in), or follow the steps in the sidebar "Reopening a COM Add-In for Editing," to open a COM add-in.
  5. Choose Tools, References in the VBE window, and look for any references that are marked MISSING. Uncheck them, and then look for the correct version of the object library (such as Microsoft DAO 3.6 Object Library) and check it.

If your code uses DAO database or recordset objects, you need a reference to the DAO object library. This reference isn’t included in a new Access 2000 or Access 2002 database—you have to add it manually. After checking all the references you need, compile the add-in (or database). (If it’s a COM add-in, save it as a DLL again.) After that the code should run.

The LNC Rename COM add-in also has a supporting code module, a standard module named basSharedCode. This module contains all the generic Office code that can be used for other designers if I decide to extend this add-in to support other Office applications. (This module currently includes only the StripNonAlphaNumericChars function and the AddInErr error handler function.) The basSharedCode module’s code is shown here.

 Option Explicit Public Function StripNonAlphaNumericChars(strText As String) As String 'Strips a variety of nonalphanumeric 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 = " `~!@#$%^&*()-_=+[{]};:',<.>/?" _    & 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)      Else        i = i + 1      End If    Loop    StripNonAlphaNumericChars = strTestString     ErrorHandlerExit:    Exit Function ErrorHandler:    AddInErr Err    Resume ErrorHandlerExit End Function 

Installing a COM Add-In

When you create a DLL for a COM add-in (by choosing File, Make ProjectName.DLL), the add-in is automatically installed on that computer. To install it on another computer, copy the DLL file to that computer’s add-ins folder (C:\Documents and Settings\User Name \Application Data\Microsoft\AddIns for Windows 2000, or C:\Windows\Application Data\Microsoft\Addins for Windows Me), open an Access database, and then open the COM Add-Ins dialog box from its toolbar button.

If the add-in appears in the list of available add-ins, just select it; otherwise, click the Add button, as shown in Figure 21-31, and select the DLL file from its folder.

figure 21-31. you install a new com add-in in the com add-ins dialog box.

Figure 21-31. You install a new COM add-in in the COM Add-Ins dialog box.

In the Add Add-In dialog box that appears, you can select the DLL file to install, as shown in Figure 21-32.

figure 21-32. you select the com dll file to install from the add add-in dialog box.

Figure 21-32. You select the COM DLL file to install from the Add Add-In dialog box.

The COM add-in now appears in the COM Add-Ins dialog box, selected, as shown in Figure 21-33. You can clear its check box to temporarily unload it, or you can select it and click the Remove button to completely remove it. It’s a good idea to remove the add-in before modifying its design; you then reinstall it after creating the new DLL file.

figure 21-33. the lnc control renamer add-in is listed as an installed com add-in.

Figure 21-33. The LNC Control Renamer add-in is listed as an installed COM add-in.

Reopening a COM Add-In for Editing

It’s easy to reopen an Access add-in for editing. Just open the MDA file as you would open any database. However, COM add-ins are prepared as VBA files and then saved as DLL files, and thus they can’t be opened directly (unless you have Visual Basic installed, in which case double-clicking a VBA file will open it in Visual Basic, which isn’t what you want when working with a COM add-in project file created with VBA).

To reopen a COM add-in project for editing, follow these steps:

  1. Open an Access database.
  2. Uninstall the COM add-in from the COM Add-Ins dialog box.
  3. In an Access window without any database opened, press Alt+F11 to open the VBE window.
  4. Choose File, Open Project, and navigate to the folder in which you saved the COM add-in project (probably the standard add-ins folder: C:\Documents and Settings\User Name \Application Data\Microsoft\AddIns folder for Windows 2000, or C:\Windows\Application Data\Microsoft\Addins for Windows Me). Select the project, and click Open, as shown in Figure 21-34.

figure 21-34. open the com add-in’s saved vba project to edit the add-in.

Figure 21-34. Open the COM add-in’s saved VBA project to edit the add-in.

The project opens in the Project Explorer, and you can edit it as needed. When you’ve finished, recompile the project by choosing Debug, Compile ProjectName, and then create an updated DLL file by choosing File, Make ProjectName.DLL.

Click OK, and you’ll see a Rename Controls button on the Form Design and Report Design toolbars. Figure 21-35 shows this button on the Form Design toolbar, in the upper right corner.

figure 21-35. the rename controls button on the form design toolbar lets you run the add-in quickly.

Figure 21-35. The Rename Controls button on the Form Design toolbar lets you run the add-in quickly.

For information about using the LNC Control Renamer add-in, see Chapter 15, "Using Add-Ins to Expand Access Functionality."

InsideOut

When you add a control to a command bar (toolbar or menu bar) in a COM add-in, you need to know the command bar’s name—the name used to reference it in VBA code. But the names on the View menu’s Toolbars submenu and in the Customize dialog box’s Toolbars list might not be the same as those used in code. You can see the command bar names by iterating through the application’s CommandBars collection, which displays the Name property of each command bar in the Immediate window.

After running the ListCommandBars function (it is located in basUtilities in the Test Access 2002 database), you will see a list of command bar names in the Immediate window. Simply select the name of the command bar you want to reference in code, copy it using Ctrl+C, and then paste it into your VBA code with Ctrl+V, to ensure that you are using the correct name for the command bar.

Although my sample COM add-in doesn’t use a form, COM add-ins in general can include UserForm objects. (You’re probably familiar with UserForms from Word, Excel, or Outlook.) By default, UserForms aren’t available in Access because Access has its own forms, which are much more useful for displaying Access data. (UserForms and controls on UserForms can’t be bound to data.) This means that you can’t use a UserForm in the Access Designer portion of a COM add-in, at least if you create the COM add-in in the Access Visual Basic Editor window.



Microsoft Access Version 2002 Inside Out
Microsoft Access Version 2002 Inside Out (Inside Out (Microsoft))
ISBN: 0735612838
EAN: 2147483647
Year: 2005
Pages: 172
Authors: Helen Feddema

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net