【发布时间】：2016-02-04 13:24:04
【问题描述】：
我更新了我创建的 Excel 插件中的代码，该插件保存在我公司的共享驱动器上。我在 Excel 功能区的自定义选项卡下添加了一些加载项宏。在更新代码之前，我已经将它设置为一个活动应用程序插件，所以我想我可以只更新代码，按钮就会像以前一样工作。但是，当我单击其中一个自定义功能区按钮时，我收到错误消息“无法运行宏“宏文件路径”。此工作簿中可能没有该宏，或者所有宏都可能被禁用”。
我已经在谷歌上搜索过解决方案，其中大多数涉及更改信任中心设置-->宏设置以启用所有宏并检查对 VBA 项目对象模型的信任访问按钮，这是我在更新加载项代码之前完成的.
我还打开了 VBE，并在我尝试从中运行加载项宏的工作簿旁边的项目资源管理器窗口中看到加载项文件。有谁知道为什么会这样？在我更新插件代码之前它工作正常。
这是原始插件代码：
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
我知道代码很长而且不是很漂亮，但是如果你想要完整的信息，这里有。
感谢您的帮助！
【问题讨论】：