asked on

Word and Excel: Possible to establish key-shortcuts to macros efficiently?

The office uses 6 standard Word and Excel VBA macros that I created. Each of these macros is associated with a key shortcut on each computer. When I setup a new computer or reinstall an old one, I take the following steps with the macros.

I create a "junk" macro on the client machine with a name that matches the first of my 6 standard marcos. (We'll call it macro1.) When creating the junk macro, I assign the correct key shortcut to the macro.

After creating the "junk" macro, I replace the contents of the macro with the contents of my macro1.

The result - My macro is functional and associated with the desired key shortcut.

This process is not efficient. There's got to be a way to import a module into my client's Normal.dotm file (or Personal.xlsb) file and "tell" Word (or Excel) to associate Ctrl + Alt + 1 with macro 1, and Ctrl + Alt + 2 with macro 2...

SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Chris Bottomley

For info then assuming you can connect to the users system then you can code the macro directly for example:

Function VBATrustedAccess() As Boolean

    On Error Resume Next
    VBATrustedAccess = (Application.VBE.VBProjects.Count) > 0
    
End Function

Sub AddMacros()
Dim strMessage As String

'    strMessage = funMacroExists("crbMacro1", "crB1")
    strMessage = funMacroExists("crbMacro1")
    If InStr(strMessage, "#Error") = 1 Then
        MsgBox strMessage
    Else
        MsgBox "Done"
    End If

End Sub

Function funMacroExists(strMacroName As String, Optional strModuleName As String) As Variant
Dim arrModuleNames As Variant
Dim objMod As Variant
Dim arrModules() As Variant
Dim bolTest As Boolean
Dim lngLine As Long
Dim objTargetModule As Object
Dim VBP As Object
Dim VBC As Object
Const strTargetModuleName As String = "CRB1"
Const vbext_pk_Proc As Long = 0
Const vbext_ct_StdModule As Long = 1

    If Not VBATrustedAccess Then
        funMacroExists = "#Error - Trusted Access to VBA project NOT granted"
        Exit Function
    End If
    Set VBP = Application.NormalTemplate.VBProject
    Set VBC = VBP.VBComponents
    If strMacroName = "" Then
        funMacroExists = "#Error - Cannot search for a macro unless identified"
        Exit Function
    End If
    If strModuleName = "" Then
        bolTest = False
        For Each objMod In VBC
            If strModuleName <> "" Then strModuleName = strModuleName & ","
            strModuleName = strModuleName & objMod.Name
            If LCase(objMod.Name) = LCase(strTargetModuleName) Then
                If LCase(objMod.Name) = LCase(strTargetModuleName) Then bolTest = True
                Set objTargetModule = objMod
            End If
        Next
    Else
        bolTest = False
        For Each objMod In VBC
            If LCase(objMod.Name) = LCase(strModuleName) Then bolTest = True
            If LCase(objMod.Name) = LCase(strTargetModuleName) Then Set objTargetModule = objMod
        Next
    End If
    If Not bolTest Then
        Set objTargetModule = VBC.Add(vbext_ct_StdModule)
        objTargetModule.Name = strTargetModuleName
    End If
    arrModuleNames = Split(strModuleName, ",")
    For Each objMod In arrModuleNames
        With VBC.Item(objMod).CodeModule
            For lngLine = 1 To .CountOfLines
                If InStr(1, .Lines(lngLine, 1), "Sub " & strMacroName & "(", vbTextCompare) Then
                    funMacroExists = "#Error - Sub """ & strMacroName & """ already exists in module """ & objMod & """"
                    Exit Function
                End If
            Next
        End With
    Next
    ' Sub does not exist ... place into the first available module!
    With objTargetModule.CodeModule
        .InsertLines .CountOfLines + 1, "Sub " & strMacroName
        .InsertLines .CountOfLines + 1, "    msgbox ""Hi from " & strMacroName & """"
        .InsertLines .CountOfLines + 1, "End Sub"
    End With
    
End Function

Open in new window

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

jdana

ASKER

Chris,

Elegant solution.

Thanks!

J