• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 499
  • Last Modified:

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...
0
jdana
Asked:
jdana
  • 3
2 Solutions
 
Chris BottomleyCommented:
Have you considered putting the macro into  master file ... and saving as a template?

If everyone has this file then it will work without more ado once the file is loaded for example to their startup folder for excel/word.

Note also if on a network the template could be central as long as each user has the global template folder enabled.

Chris
0
 
Chris BottomleyCommented:
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

0
 
Chris BottomleyCommented:
Noting your original intent was to import a code module rather than insert a module into which you inject the code then for example

Function funLoadModule(strModulePathAndName As String, Optional bolForceChange As Boolean) As Variant
Dim objMod As Variant
Dim bolTest As Boolean
Dim objTargetModule As Object
Dim VBP As Object
Dim VBC As Object
Dim strModuleName As Variant
Dim fso As Object

    If Not VBATrustedAccess Then
        funLoadModule = "#Error - Trusted Access to VBA project NOT granted"
        Exit Function
    End If
    Set fso = CreateObject("scripting.filesystemobject")
    If Not fso.fileexists(strModulePathAndName) Then
        funLoadModule = "#Error - Specifed Module not found"
        Exit Function
    End If
    Set fso = Nothing
    Set VBP = Application.NormalTemplate.VBProject
    Set VBC = VBP.VBComponents
    bolTest = False
    strModuleName = Split(strModulePathAndName, "\")
    strModuleName = CStr(strModuleName(UBound(strModuleName)))
    strModuleName = LCase(Split(strModuleName & ".", ".")(0))
    For Each objMod In VBC
        If LCase(objMod.Properties("Name").Value) = strModuleName Then
            Set objTargetModule = objMod
            bolTest = True
            Exit For
        End If
    Next
    If bolTest Then
        If bolForceChange Then
            VBC.Remove objTargetModule
            VBC.import strModulePathAndName
            funLoadModule = "Completed"
        Else
            funLoadModule = "#Error - VBA project already includes selected module"
            Exit Function
        End If
    Else
        VBC.import strModulePathAndName
        funLoadModule = "Completed"
    End If

End Function

Open in new window


The function can be used as:

strStatus = funLoadModule ("C:\VBA\File1.bas", True)' Force module to be replaced

or

strStatus = funLoadModule ("C:\VBA\File1.bas")' Insert but do not replace module

Chris
0
 
jdanaAuthor Commented:
Chris,

Elegant solution.

Thanks!

J
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now