以编程方式将外接宏添加到快速访问工具栏 | 以编程方式将外接宏添加到快速访问工具栏

本文介绍了以编程方式将外接宏添加到快速访问工具栏的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我有一个格式化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.

我的计划是将加载项放置在我的本地addins文件夹中.在那里进行任何更新，然后运行一个例程，将该插件复制到网络位置，并将其设置为只读和隐藏.其他用户在其本地计算机上将没有插件，因此当他们重新启动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设置的同时，我还没有找到执行此操作的方法.我想大多数用户根本不会对用户界面进行很大的调整，但是我宁可不负责弄乱某人的用户界面.

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存储在"this workbook"中Common Size AR installer.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:\NetworkDrive\Common 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

推荐答案

运行Sub add菜单-这将创建add ins选项卡，添加菜单使用按钮运行removemenu子菜单，它将添加菜单标签和按钮即可

Run the Sub add menu - this will create the add ins tab, add the menuwith the button run the removemenu sub and it will take the adds inmenu 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

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