Question

我更新了我创建的excel加载项中的代码，该加载项保存在我公司的共享驱动器中。我在Excel功能区的自定义选项卡下添加了一些加载项宏。在更新代码之前，我已经将它设置为Active Application Add-In，所以我想我可以只更新代码，按钮就像以前一样工作。但是，当我单击其中一个自定义功能区按钮时，我收到错误＆＃34;无法运行宏＆＃34;宏文件路径＆＃34;。宏可能在此工作簿中不可用，或者可能禁用所有宏＆＃34;。

我已经搜索了解决方案，大部分涉及更改信任中心设置 - ＆gt;宏设置启用所有宏并检查信任访问VBA项目对象模型按钮，我在更新添加之前已经完成 - 代码。

我还打开了VBE并在工作簿旁边的Project Explorer窗口中看到了加载项文件，我试图从中运行加载项宏。有谁知道为什么会这样？在更新加载项代码之前，它工作正常。

以下是原始加载项代码：

Function BuildBudgetSQL(PageFilters As Range, Table As Range)
Application.Volatile
    'PageFilters As String, Year As Date, x_axis As String, y_axis As String)

    Dim cell As Range

    'Starts SQL statement
    BuildBudgetSQL = "SELECT * FROM " & "[" & Table.Offset(0, 2).Value & "]" & " WHERE "

    'Adds WHERE and AND clauses to SQL statement
    For Each cell In PageFilters
        BuildBudgetSQL = BuildBudgetSQL & "[" & cell.Value & "] " & cell.Offset(0, 1) & " '" & cell.Offset(0, 2).Value & "'" & " " & cell.Offset(1, -1).Value & " "
    Next

    'Chops off trailing " AND" and add ";" on end of SQL statement
    BuildBudgetSQL = Mid(BuildBudgetSQL, 1, Len(BuildBudgetSQL) - 2) & ";"

End Function

Sub GetBudgetTable()

Dim dbFilePath As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim cell As Range
Dim Year As String
Dim SQL As String

'For Each cell In Range("A1:A100")
    'If InStr(1, cell.Name, "SQL", vbTextCompare) > 0 Then

        Year = Sheets("Report").Range("Year").Value
        SQL = Sheets("Report").Range("BudgetSQL").Value

        dbFilePath = "H:\CORP\CFR-2011_to_Current\Budget\2015\Budget Variance\Budget Variance - Pivot\Test\More Tests\Administrative\Database\" & Year & " Budget.accdb"
        Set db = Access.DBEngine.OpenDatabase(dbFilePath, False, True)
        Set rs = db.OpenRecordset(SQL)

        Sheets("Budget Table").Range("a2:y50000").ClearContents
        Sheets("Budget Table").Range("A2").CopyFromRecordset rs
        db.Close

        Sheets("Report").PivotTables("BudgetDetail").RefreshTable

    'End If
'Next
End Sub

这是新代码：

Function BuildSQL(FieldNames As Range, Table As Range, PageFilters As Range)

Application.Volatile

Dim cell As Range

'Starts SQL statement
BuildSQL = "SELECT "

'Adds field names to SELECT clause of SQL statement
For Each cell In FieldNames
    If cell.Value <> "" Then
        BuildSQL = BuildSQL & "[" & Table.Offset(0, 2).Value & "]." & "[" & cell.Value & "]" & ", "
    End If
Next

'Chops off trailing "," on end of SQL statement
BuildSQL = Mid(BuildSQL, 1, Len(BuildSQL) - 2)

'Adds FROM clause, table name, and WHERE clause
BuildSQL = BuildSQL & " FROM " & "[" & Table.Offset(0, 2).Value & "]" & " WHERE "

'Adds criteria to SQL statement's WHERE clause
For Each cell In PageFilters
    If cell.Value <> "" Then
        BuildSQL = BuildSQL & "[" & cell.Value & "] " & cell.Offset(0, 1) & " '" & cell.Offset(0, 2).Value & "'" & " " & cell.Offset(1, -1).Value & " "
    End If
Next

'Chops off trailing " AND" and add ";" on end of SQL statement
BuildSQL = Mid(BuildSQL, 1, Len(BuildSQL) - 2) & ";"

End Function

Sub GetBudgetTable()

Dim dbFilePath As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim cell As Range
Dim Year As String
Dim SQL As String

        Year = Sheets("Report").Range("Year").Value
        SQL = Sheets("Report").Range("BudgetSQL").Value

        'pulls budget
        dbFilePath = "H:\CORP\CFR-2011_to_Current\Budget\2015\Budget Variance\Budget Variance - Pivot\Test\More Tests\Administrative\Database\" & Year & " Budget.accdb"
        Set db = Access.DBEngine.OpenDatabase(dbFilePath, False, True)
        Set rs = db.OpenRecordset(SQL)

        Sheets("Budget Table").Range("A2:AJ80000").ClearContents
        Sheets("Budget Table").Range("A2").CopyFromRecordset rs
        db.Close

        'pulls actuals
        dbFilePath = "H:\CORP\CFR-2011_to_Current\Budget\2015\Budget Variance\Budget Variance - Pivot\Test\More Tests\Administrative\Database\" & Year & " Actuals - Summary.accdb"
        Set db = Access.DBEngine.OpenDatabase(dbFilePath, False, True)
        Set rs = db.OpenRecordset(SQL)

        Sheets("Budget Table").Range("A2").End(xlDown).Offset(1, 0).CopyFromRecordset rs
        db.Close

        Sheets("Report").PivotTables("Pivot").RefreshTable

End Sub

Sub ActualDrilldown()
'http://stackoverflow.com/questions/34804259/vba-code-to-return-pivot-table-cells-row-column-and-page-fields-and-items/34830798?noredirect=1#comment57563829_34830798

Dim pvtCell As Excel.PivotCell
Dim pvtTable As Excel.PivotTable
Dim pvtField As Excel.PivotField
Dim pvtItem As Excel.PivotItem
Dim pvtParentItem As Excel.PivotField
Dim i As Long
Dim SQL As String
Dim dict As Scripting.Dictionary

Set dict = New Scripting.Dictionary

dict.Add "Jan", "Jan"
dict.Add "Feb", "Feb"
dict.Add "Mar", "Mar"
dict.Add "Apr", "Apr"
dict.Add "May", "May"
dict.Add "Jun", "Jun"
dict.Add "Jul", "Jul"
dict.Add "Aug", "Aug"
dict.Add "Sep", "Sep"
dict.Add "Oct", "Oct"
dict.Add "Nov", "Nov"
dict.Add "Dec", "Dec"

On Error Resume Next
Set pvtCell = ActiveCell.PivotCell
If Err.Number <> 0 Then
    MsgBox "The cursor needs to be in a pivot table"
    Exit Sub
End If
On Error GoTo 0

If pvtCell.PivotCellType <> xlPivotCellValue Then
    MsgBox "The cursor needs to be in a Value field cell"
    Exit Sub
End If

SQL = "SELECT * FROM [Actual Detail] WHERE "

'Checks if PivotField.SourceName contains a month.  If not, exit sub; otherwise, adds Value Field Source to SQL statement
If dict.Exists(Left(pvtCell.PivotField.SourceName, 3)) = False Then
    MsgBox "A month field must be in the column field of the active pivot cell before drilling.", vbOKOnly
    Exit Sub
End If
SQL = SQL & "[" & Left(pvtCell.PivotField.SourceName, 3) & "]" & "IS NOT NULL AND "

'Adds rowfields and rowitems to SQL statement
For i = 1 To pvtCell.RowItems.Count
    Set pvtParentItem = pvtCell.RowItems(i).Parent
    SQL = SQL & "[" & pvtParentItem.Name & "]" & "=" & "'" & pvtCell.RowItems(i).Name & "'" & " AND "
Next i

'Adds columnfields and columnitems to SQL statement
For i = 1 To pvtCell.ColumnItems.Count
    Set pvtParentItem = pvtCell.ColumnItems(i).Parent
    SQL = SQL & "[" & pvtParentItem.Name & "]" & "=" & "'" & pvtCell.ColumnItems(i).Name & "'" & " AND "
Next i

'Chops off trailing "AND" on end of SQL statement
SQL = Mid(SQL, 1, Len(SQL) - 5) & ";"

Debug.Print SQL

End Sub

我知道代码很长而且不漂亮，但是如果你想要完整的信息，就可以了。

感谢您的帮助，谢谢你们！

Answer 1

我明白了！我需要做两件事：

1）我将ActiveWorkbook添加到适用的子代码中。

2）这是一个棘手的部分 - 我意识到我必须从Excel功能区中删除sub，然后将其添加回来。显然，当您更新加载项中的子项时，运行该子项的Excel功能区上的按钮不会更新。您必须从Excel功能区中删除该按钮并将其重新添加。

完成这两个步骤后，加载项才能正常工作。

我确信希望每当我对加载项进行更改时，都必须手动删除并添加加载项子。我会谷歌这个，也许会打开一个新的问题主题。

从Excel功能区运行Excel加载项宏时出错

1 个答案: