以编程方式将加载项宏添加到快速访问工具栏 [英] Programmatically Add Add-In Macro to Quick Access Toolbar

问题描述

我有一个格式化 Excel 报告的宏.这个宏需要在许多不同的工作簿上运行，因为每天都会生成报告并将其保存到一个新文件中.这一直在我的个人工作簿中.我现在需要分享这个宏.

I have a macro that formats an Excel report. This macro needs to run on many different workbooks as the report is generated and saved to a new file every day. This has been in my personal workbook. I now need to share this macro.

我的计划是将加载项放在我的本地插件文件夹中.在那里进行任何更新并运行将插件复制到网络位置并将其设置为只读和隐藏的例程.其他用户的本地计算机上没有插件，因此当他们重新启动 Excel 时，更新将生效.

My plan is to have the add-in in my local addins folder. Make any updates there and run a routine which copies the addin to the network location and sets it to read only and hidden. Other users will not have the addin on their local machine so when they restart Excel the updates will take effect.

我创建了一个虚拟安装程序工作簿"；这将从网络位置加载插件，并确保用户不会将插件复制到他们的本地计算机.

I created a "dummy Installer workbook" that will load the addin from the network location and make sure the user does not copy the addin to their local machine.

我希望这个虚拟工作簿为快速访问工具栏的插件添加一个按钮，这样我就不必向用户解释该过程.在保留用户当前 UI 设置的同时，我还没有找到一种方法.我想大多数用户都没有对他们的 UI 进行太多调整(如果有的话)，但我宁愿不对弄乱某人的 UI 负责.

I would like this dummy workbook to add a button for the addin to the Quick Access Toolbar so I do not have to explain the process to the users. I have not found a way to do this while preserving the user's current UI settings. I imagine most of the users have not tweaked their UI very much if at all but I would rather not be responsible for messing up someone's UI.

我仍在学习如何使用 VBA，它正在部署在对我来说也有点新的网络环境中.

I am still learning how to work with VBA and this is being deployed in a network environment which is also a little new to me.

注意:

• CommonSizeAR 代码位于 Common Size AR.xlam 的模块 1 中，而 DeployAddIn 位于模块 2 中.
• Workbook_Open 存储在此工作簿"中.通用大小的 AR 安装程序.xlsm.

Private Sub deployAddIn()

    Dim strAddinDevelopmentPath As String
    Dim strAddinPublicPath As String 

    strAddinDevelopmentPath = "C:AddIns" & Application.PathSeparator
    strAddinPublicPath = "W:NetworkDrive" & Application.PathSeparator
    Application.DisplayAlerts = False

    With ThisWorkbook
        .Save
        On Error Resume Next
        SetAttr strAddinPublicPath & .Name, vbNormal
        On Error GoTo 0
        .SaveCopyAs Filename:=strAddinPublicPath & .Name
        SetAttr strAddinPublicPath & .Name, vbReadOnly + vbHidden
    End With

    Application.DisplayAlerts = True

End Sub

Private Sub workbook_open()

    Dim Result As Integer

    Result = MsgBox("Would you like to install the Common Size AR Add-in?", _
      vbYesNo + vbQuestion, "Install?")

    If Result = vbNo Then
        Application.ThisWorkbook.Close SaveChanges:=False
        Exit Sub
    End If

    On Error Resume Next
    AddIns("Common Size AR").Installed = False
    On Error GoTo ErrorHandler1

    AddIns.Add Filename:="W:NetworkDriveCommon Size AR.xlam", Copyfile:=False
    AddIns("Common Size AR").Installed = True
    MsgBox "Add-in Installed!", vbOKOnly + vbInformation, "Done!"
    Application.ThisWorkbook.Close SaveChanges:=False

    Exit Sub

ErrorHandler1:
    MsgBox "Install Failed! Please let Developer know", vbOKOnly + vbCritical, "Error!"
    Exit Sub 

End Sub

推荐答案

运行子添加菜单 - 这将创建插件选项卡，添加菜单使用按钮运行 removemenu 子，它将添加菜单标签和按钮离开

Run the Sub add menu - this will create the add ins tab, add the menu with the button run the removemenu sub and it will take the adds in menu tab and button away

Option Explicit

Sub AddMenu()
Dim Mycbar As CommandBar, Mycontrol As CommandBarControl, Mypopup As CommandBarPopup

Application.ScreenUpdating = False
RemoveMenu ' call remove routine to ensure only one menu in place

Set Mycbar = CommandBars.Add _
(Name:="TO's Menubar", Position:=msoBarBottom, Temporary:=False)
' create new commandbar (menu bar)

Set Mycontrol = Mycbar.Controls.Add(msoControlButton)
' create new commandbar control (button type) on custom menu
With Mycontrol
.Caption = "Smiley Yes/No" ' mouseover text
.Tag = "Smiley" ' used for identification
.OnAction = "MySub" ' macro called with control
.FaceId = 59 ' appearance, based on built-in faces
End With

Set Mypopup = Mycbar.Controls.Add(msoControlPopup)
' create new commandbar control (popup menu type) on custom menu
With Mypopup
.BeginGroup = True ' start new group
.Caption = "TO Menu Items" ' mouseover text
.Tag = "TOMenu" ' used for identification
End With

'============================================================================
'Add various sub-menu items to the popup control

Set Mycontrol = Mypopup.Controls.Add(msoControlButton)
With Mycontrol
.Caption = "Text Converter" ' menu item description
.Tag = "Text Converter" ' used for identification
.OnAction = "TextCon" ' macro called with control
.FaceId = 59 ' appearance, based on built-in faces
End With

'===============================================================================

Mycbar.Visible = True
Application.ScreenUpdating = True

Set Mycbar = Nothing 'release memory
Set Mycontrol = Nothing
Set Mypopup = Nothing

End Sub

Sub RemoveMenu()
Dim Mycbar As CommandBar

On Error Resume Next ' in case its already gone
Set Mycbar = CommandBars("TO's Menubar")
Mycbar.Delete
Set Mycbar = Nothing 'release memory

End Sub

Sub MySub()
Dim ans As Integer

ans = MsgBox("Do you want to remove the custom menu?", vbYesNo, "TO Custom Menu")
If ans = 6 Then RemoveMenu

End Sub

'text converter
Sub TextCon()
Dim ocell As Range, ans As String

ans = Application.InputBox("Type in Letter" & vbCr & _
"(L)owercase, (U)ppercase, (S)entence, (T)itles ")

If ans = "" Then Exit Sub

For Each ocell In Selection.SpecialCells(xlCellTypeConstants, 2)
Select Case UCase(ans)
Case "L": ocell = LCase(ocell.Text)
Case "U": ocell = UCase(ocell.Text)
Case "S": ocell = UCase(Left(ocell.Text, 1)) & _
LCase(Right(ocell.Text, Len(ocell.Text) - 1))
Case "T": ocell = Application.WorksheetFunction.Proper(ocell.Text)
End Select
Next
End Sub

这篇关于以编程方式将加载项宏添加到快速访问工具栏的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！