Question

我正在为Excel 2003编写一个小型VBA加载项，其想法是加载项在目录中查找任何“.xlt”文件，并且对于每个文件，它都会在“模板”中添加一个按钮。菜单，提供快速获取空白模板的方法。大多数加载项工作得很好，但是我遇到了一点点麻烦，我很难理解为什么它不起作用。

以下是构建菜单的代码示例。

Public Sub BuildMenu()

Dim Active_Menu_Bar As Office.CommandBar
Dim Tmplts_MenuItem As Office.CommandBarControl
Dim Tmplts_MenuControl As Office.CommandBarControl
Dim objSearch
Dim TemplatesPath As String

DeleteControls

Application.Interactive = False

Set Active_Menu_Bar = Application.CommandBars.Item(1)
Set Tmplts_MenuItem = Active_Menu_Bar.Controls.Add(msoControlPopup, , , 10, True)

With Tmplts_MenuItem
    .Caption = "Templates"
    .BeginGroup = False
    .Tag = C_TAG
End With

TemplatesPath = FetchValue("TemplatesPath")

Set objSearch = Application.FileSearch
    objSearch.LookIn = TemplatesPath
    objSearch.SearchSubFolders = False
    objSearch.Filename = "*.xlt"
    objSearch.Execute

For Each strFile In objSearch.FoundFiles

    'Remove Path from strFile
    strFile = Replace(strFile, TemplatesPath, "")

    Select Case strFile
        Case "Journal.xlt"
            Set Tmplts_MenuControl = Tmplts_MenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
            With Tmplts_MenuControl
                .Caption = "New Journal"
                .OnAction = "'" & ThisWorkbook.Name & "'!NewJournal"
                .Tag = C_TAG
            End With

        Case "Budget Journal.xlt"
            Set Tmplts_MenuControl = Tmplts_MenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
            With Tmplts_MenuControl
                .Caption = "New Budget Journal"
                .OnAction = "'" & ThisWorkbook.Name & "'!NewBudgetJournal"
                .Tag = C_TAG
            End With

        Case Else
            Set Tmplts_MenuControl = Tmplts_MenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
            With Tmplts_MenuControl
                .Caption = "New " & strFile
                .OnAction = "'" & ThisWorkbook.Name & "'!NewGenericTemplate(""" & TemplatesPath & strFile & """)"
                .Tag = C_TAG
            End With

    End Select
Next

Set objSearch = Nothing

Set Tmplts_MenuControl = Tmplts_MenuItem.Controls.Add(Type:=msoControlButton, temporary:=True)
With Tmplts_MenuControl
    .Caption = "User Preferences"
    .OnAction = "'" & ThisWorkbook.Name & "'!UserPrefs"
    .BeginGroup = True
    .Tag = C_TAG
End With

Application.Interactive = True

End Sub

正如您所看到的，有一个select case语句，它表示特定的'已知'模板为ordeer中的按钮分配一个宏来处理该模板的要求（例如，Journal模板的宏也会填充一对模板上始终具有特定值的字段，例如由application.username填充的用户名），此位按预期工作。

问题在于Case Else。我希望能够获取恰好位于目录中的任何其他模板，并将完整路径传递给“通用”宏，该宏将仅基于模板创建一个新工作簿而没有任何花哨的额外内容，因此在{{1 OnAction的一部分我正在通过模板的完整路径。

然而，当我点击菜单控件时，没有任何反应，没有错误信息，没有。

以下是MenuControl宏的代码。

NewGenericTemplate

简单的东西（意思是我可能忘记了一些非常明显的东西），当我意识到菜单按钮不起作用时我添加了Sub NewGenericTemplate(MyTemplate As String) Workbooks.Add Template:=MyTemplate MsgBox MyTemplate End Sub并且我想检查该值是否实际被传递了所以现在而不是什么，我得到msgbox（由于某种原因两次），它显示模板的正确路径，但工作簿没有添加。

任何帮助都将不胜感激。

P.S。我也尝试在msgbox宏中设置断点，但代码没有中断

Answer 1

行。我能够修改this thread的建议。

使用新控件，像这样添加.Parameter：

With Tmplts_MenuControl
   .OnAction = "'" & ThisWorkbook.Name & "'!NewGenericTemplate"
  .Parameter = "'" & ThisWorkbook.FullName & "'!NewGenericTemplate"
  .Caption = "New Generic Template"
  .FaceId = 99
  .Style = msoButtonCaption
  .BeginGroup = True
End With

然后，我修改NewGenericTemplate子例程以接收此.Parameter。的种类。由于我们无法通过索引引用控件，因为它们看起来是动态的，我只是循环遍历现有的控件/子控件，并根据控件的myTemplate值分配.OnAction。 p>

Sub NewGenericTemplate()
Dim varControls As Variant 'top level controls
Dim ctrl As Variant 'secondary controls within top-level
Dim myTemplate As String

'Since I can't refernce the controls by Index (they are dynamic), we loop over them:
For Each varControls In Application.CommandBars("Command Bar Name").Controls '<--- EDIT AS NECESSARY
    For Each ctrl In varControls.Controls
        If ctrl.OnAction = "'" & ThisWorkbook.FullName & "'!NewGenericTemplate" Then
            myTemplate = ctrl.Parameter
            GoTo EarlyExit:
        End If
    Next
Next

Exit Sub 'if no parameter has been assigned.

EarlyExit:
If Not myTemplate = vbNullString Then
    Workbooks.Add Template:=myTemplate
End If

End Sub

这对我来说是成功的，之前的尝试都因您遇到的问题而失败。

Answer 2

不幸的是，我不得不把这个问题放在一边几个星期，但今天我回到它，我决定回到基础，只是寻找一种方法将一个变量从菜单按钮传递给宏引导我this thread。

我现在所做的是从

更改.OnAction属性

.OnAction = "'" & ThisWorkbook.Name & "'!NewGenericTemplate(""" & TemplatesPath & strFile & """)"

到

.OnAction = "'NewGenericTemplate """ & strFile & """'"

所以基本上删除了包含宏的文件的引用。我也只是传递文件名而不是完整路径，所以下面是我现在用于NewGenericTemplate例程的代码。

Public Sub NewGenericTemplate(MyTemplate As String)

Dim TemplatesPath As String
Dim FullPathToTemplate As String

'Retrieve path to Templates Directory
TemplatesPath = FetchValue("TemplatesPath")

FullPathToTemplate = TemplatesPath & MyTemplate

If Dir(FullPathToTemplate) <> "" Then
    Workbooks.Add FullPathToTemplate
    Else
    MsgBox "Template File not Found, it may have been moved or deleted.", vbExclamation, "File Not Found"
End If

End sub

希望它应该排序。

基于模板添加工作簿

2 个答案: