Reputation: 701
I updated the code in an excel add-in I created that is saved on my company's shared drive. I've added some of the add-ins macros under a custom tab on the Excel ribbon. Before updating the code, I already had it set as an Active Application Add-In, so I figured I could just update the code and the buttons would work just like they were before. However, when I click one of the custom ribbon buttons I get the error "Cannot run the macro "macro file path". The macro may not be available in this workbook or all macros may be disabled".
I've googled for solutions already and most involve changing Trust Center Settings-->Macro Settings to Enable all macros and checking the Trust Access to the VBA project object model button, which I had done before updating the add-in code.
I've also opened up the VBE and see the add-in file in the Project Explorer window right next to the workbook I'm trying to run the add-in macro from. Does anyone know why this is happening? It was working fine until I updated the add-in code.
Here is the original add-in code:
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
And here's the new code:
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
I know the code is long and isn't pretty, but if you want the full information, there it is.
I appreciate and thank you for your help!
Upvotes: 2
Views: 1237
Reputation: 701
I figured it out! There were two things I needed to do:
1) I added ActiveWorkbook to the subs code where applicable.
2) This was the tricky part - I realized I have to remove the sub from the Excel ribbon and then add it back. Apparently, when you update a sub in the add-in, the button on the Excel ribbon that runs that sub does not update. You have to remove the button from the Excel ribbon and add it back on.
After doing both of these steps, the add-in worked correctly.
I sure hope there is a way around having to manually remove and add the add-in sub back each time I make a change to the add-in. I'll google this and maybe open up a new question thread.
Upvotes: 1