logo标签列表

何时为Excel插件设置MacroOptions

vbaexcelexcel-addins
4

我正在制作一款Excel插件。它由模块内的几个函数组成，就像这样：

Public Function MyFunctionOne(X As Range, Y As Double) As Double
    MyFunctionOne = 1 'Example
End Function
Public Function MyFunctionTwo(X As Range, Y As Double) As Double
    MyFunctionTwo =  2 'Example
End Function
Public Function MyFunctionThree(X As Range, Y As Double) As Double
    MyFunctionThree =  3 'Example
End Function

我已将整个内容保存为 .xlam Excel 加载项。这样，每次我打开新的电子表格时这些函数都是可用的。
最近我学到了可以将我的函数分配到一个类别中，这真是太有帮助了。这可以使它们在 Excel 函数向导中更易于使用。我使用以下代码来分配类别：
Public Sub MyRegister()
    Application.MacroOptions Macro:="MyFunctionOne", Description:="Returns 1", Category:="My New Category"
    Application.MacroOptions Macro:="MyFunctionTwo", Description:="Returns 2", Category:="My New Category"
    Application.MacroOptions Macro:="MyFunctionThree", Description:="Returns 3", Category:="My New Category"
End Sub

现在，如果我手动运行宏 MyRegister，所有函数都会得到新的类别，并且可以正常工作。但我不想每次启动新电子表格时都手动运行宏。我的问题是，如何使插件可以自动为每个新电子表格执行此操作？
我尝试将其放入插件的 Workbook_Open 中，就像这样：
Private Sub Workbook_Open()
    Call MyRegister
End Sub

问题在于它无法正常工作。每次启动Excel时，我都会收到错误消息：“无法编辑隐藏工作簿上的宏。”因此，在Workbook_Open事件中执行此操作似乎是错误的位置。
所以我的问题是，如何在适当的时间运行MyRegister宏，以将我的插件函数分配给类别？
顺便说一下，我真的不想制作模板。我真的只想保持这个插件。
谢谢！
4个回答
5

不要使用Workbook_Open，你可以这样做：

Private WithEvents App As Application

Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    MyRegister
End Sub

Private Sub Workbook_Open()
    Set App = Application
End Sub

那样做可以在工作簿处于活动状态时运行，避免出现错误。
MyRegister 只需要运行一次。为了避免在激活多个工作簿时重复执行，请考虑在 MyRegister 后添加 Set App = Nothing。 - J. Woolley
1

快要完成了。只需将插件转换为普通工作簿，设置选项并将其重新设置为插件即可。有关详细信息，请参阅代码注释。

Public Sub MyRegister()
    Application.ScreenUpdating = False '/ Turn it off to avoid flicker.
    ThisWorkbook.IsAddin = False '/ Make the add-in workbook as normal, hence unhiding sheets
    Application.MacroOptions Macro:="MyFunctionOne", Description:="Returns 1", Category:="My New Category"
    Application.MacroOptions Macro:="MyFunctionTwo", Description:="Returns 2", Category:="My New Category"
    Application.MacroOptions Macro:="MyFunctionThree", Description:="Returns 3", Category:="My New Category"
    ThisWorkbook.IsAddin = True '/ Set back as add-in, hides everything.
    Application.ScreenUpdating = True '/ Turn on screen updating
End Sub
1
FYI，这个解决方案会让 Excel 在每次退出时询问是否要保存我的 xlam。可能是由于 ThisWorkbook.IsAddin 切换导致的。在某些情况下，屏幕也会闪烁，因此 Application.ScreenUpdating = False 似乎不能始终正常工作。 - Björn Buckwalter
0
将RegisterUDF()放在一个私有模块中，然后可以从WorkbookOpen()中调用它，这样就不会生成错误信息：

无法编辑隐藏工作簿中的宏。

0

在我写这篇文章的时候，这个问题已经相当老了（已经有5年了），但是这个问题为我提供了我需要完全解决这个问题的信息。我能够采用@jerryact提供的答案并加以扩展来解决我的问题。

首先，与原帖作者类似，我将我的UDF注册在Workbook_Open事件中，当作为Add-In加载时，会导致打开Excel时显示Run-time error '1004': Cannot edit a macro on a hidden workbook. Unhide the workbook using the Unhide command.错误消息。

使用上面@jerryact的答案中的信息，我将我的代码更改为以下内容：

Option Explicit

Private WithEvents App As Application

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    modUDFs.UnregisterUDF "DMS_2_DD"
    modUDFs.UnregisterUDF "DD_2_DMS"
    modUDFs.UnregisterUDF "ElapsedTime"
End Sub

Private Sub Workbook_Open()
    Set App = Application
End Sub

Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    modUDFs.RegisterUDF "Converts Decimal Degrees to Degrees, Minutes, Seconds" & vbLf & "rbcDD_2_DMS(<Decimal Degrees>)", "DD_2_DMS", 3
    modUDFs.RegisterUDF "Converts Degrees, Minutes, Seconds to Decimal Degrees" & vbLf & "rbcDMS_2_DD(<Degrees Minutes Seconds>)", "DMS_2_DD", 3
    modUDFs.RegisterUDF "Calculates the Time between two time stamps" & vbLf & _
                        "rbcElapsedTime(<end time>,<start time>,<output code>)" & vbLf & _
                        "0 = <Seconds>,  1 = <Minutes:Seconds>" & vbLf & _
                        "2 = <Hours:Minutes:Seconds>,  3 = <Days Hours:Minutes:Seconds>", "ElapsedTime", 2
End Sub

这个方法非常有效，看起来解决了我的问题（99.9%的情况下都是如此）。然而，我知道用户随时可以卸载我的插件，所以我想确保当我的插件被卸载时，它提供和注册的UDF也被注销。这意味着@jerryact提供的解决方案会导致与之前相同的错误消息，但只在用户打开Excel但在实际打开工作簿或创建空白工作簿之前关闭应用程序的特定情况下。这让我想到了最终的解决方案，如下所示：

Option Explicit

Private WithEvents App As Application

Private Sub App_WindowDeactivate(ByVal Wb As Workbook, ByVal Wn As Window)
    modUDFs.UnregisterUDF "DMS_2_DD"
    modUDFs.UnregisterUDF "DD_2_DMS"
    modUDFs.UnregisterUDF "ElapsedTime"
End Sub

Private Sub Workbook_Open()
    Set App = Application
End Sub

Private Sub App_WorkbookActivate(ByVal Wb As Workbook)
    modUDFs.RegisterUDF "Converts Decimal Degrees to Degrees, Minutes, Seconds" & vbLf & "rbcDD_2_DMS(<Decimal Degrees>)", "DD_2_DMS", 3
    modUDFs.RegisterUDF "Converts Degrees, Minutes, Seconds to Decimal Degrees" & vbLf & "rbcDMS_2_DD(<Degrees Minutes Seconds>)", "DMS_2_DD", 3
    modUDFs.RegisterUDF "Calculates the Time between two time stamps" & vbLf & _
                        "rbcElapsedTime(<end time>,<start time>,<output code>)" & vbLf & _
                        "0 = <Seconds>,  1 = <Minutes:Seconds>" & vbLf & _
                        "2 = <Hours:Minutes:Seconds>,  3 = <Days Hours:Minutes:Seconds>", "ElapsedTime", 2
End Sub

请注意，Workbook_BeforeClose事件已经被移除了，我将取消注册调用移到了App_WindowDeactivate事件中。这解决了两个问题，并使我的Add-In可以注册和取消注册我的UDF。上面的所有代码都放在了ThisWorkbook中，下面的代码处理UDFs的注册和取消注册，并放在我的modUDFs代码模块中。
Sub RegisterUDF(ByVal fDescription As String, ByVal fUDFName As String, ByVal fCategory As Variant)
    'Integer Category
    '1   Financial
    '2   Date & Time
    '3   Math & Trig
    '4   Statistical
    '5   Lookup & Reference
    '6   Database
    '7   Text
    '8   Logical
    '9   Information
    '10  Commands
    '11  Customizing
    '12  Macro control
    '13  DDE/External
    '14  User Defined
    '15  First custom category
    '16  Second custom category
    '17  Third custom category
    '18  Fourth custom category
    '19  Fifth custom category
    '20  Sixth custom category
    '21  Seventh custom category
    '22  Eighth custom category
    '23  Ninth custom category
    '24  Tenth custom category
    '25  Eleventh custom category
    '26  Twelfth custom category
    '27  Thirteenth custom category
    '28  Fourteenth custom category
    '29  Fifteenth custom category
    '30  Sixteenth custom category
    '31  Seventeenth custom category
    '32  Eighteenth custom category
    
    If IsNull(fCategory) Then fCategory = 9
    If fCategory = "" Then fCategory = 9
    Application.MacroOptions Macro:=fUDFName, Description:=fDescription, Category:=fCategory
End Sub

Sub UnregisterUDF(ByVal fUDFName As String)
    Application.MacroOptions Macro:=fUDFName, Description:=Empty, Category:=Empty
End Sub
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接