pawebb
Board Regular
- Joined
- Aug 10, 2007
- Messages
- 136
I have a macro that I have been calling from a form without issue. I have created an add-in that creates a new menu. When trying to execute the macro from the menu I receive an error message that states "The macro 'OpenCaseReport(1)' cannot be found." All other macros run without issue. I am guessing it has to do with how I am calling. Need some HELP!
The cmdbarmacro to create the menu is...
And the macro I am trying to call is...
The cmdbarmacro to create the menu is...
Code:
Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCustomMenu As CommandBarControl
' (1) Delete any existing one
' We must use On Error Resume Next in case it does not exist
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&Cox Reporting").Delete
On Error GoTo 0
' (2) Set a CommandBar variable to Worksheet menu bar
Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
' (3) Return the Index number of the Help menu
' We can then use this to place a custom menu before the Help menu
iHelpMenu = cbMainMenuBar.Controls("Help").Index
' Add a Control to the "Worksheet Menu Bar" BEFORE the Help menu
' And set a Control (CommandBarControl) variable to it
Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, before:=iHelpMenu)
' Give the CommandBarControl a caption
cbcCustomMenu.Caption = "&Cox Reporting"
With cbcCustomMenu
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Open SR Report"
With .Controls.Add(Type:=msoControlButton)
.Caption = "2618 - IT"
.OnAction = "OpenCaseReport(1)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4472 - BTS"
.OnAction = "OpenCaseReport(2)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4473 - Las Vegas"
.OnAction = "OpenCaseReport(3)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4474 - Phoenix"
.OnAction = "OpenCaseReport(4)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4475 - 7600"
.OnAction = "OpenCaseReport(5)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4476 - Ent."
.OnAction = "OpenCaseReport(6)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4477 - Misc."
.OnAction = "OpenCaseReport(7)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4488 - CMTS"
.OnAction = "OpenCaseReport(8)"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "4770 - IPCC"
.OnAction = "OpenCaseReport(9)"
End With
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Format Case List"
.OnAction = "FormatSR"
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Update"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Open"
.OnAction = "OpenUpdate"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Closed"
.OnAction = "ClosedUpdate"
End With
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Miscellaneous "
With .Controls.Add(Type:=msoControlButton)
.Caption = "Conditional Row Deletion"
.OnAction = "DeleteRows"
End With
End With
End With
End Sub
Code:
Sub OpenCaseReport(s As Integer)
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim word As String
' On Error GoTo Err_Execute
Select Case s
Case 1
word = "2618"
Case 2
word = "4472"
Case 3
word = "4473"
Case 4
word = "4474"
Case 5
word = "4475"
Case 6
word = "4476"
Case 7
word = "4477"
Case 8
word = "4488"
Case 9
word = "4770"
End Select
Application.ScreenUpdating = False
StartWorkbook = ActiveWorkbook.Name
StartSheet = ActiveSheet.Name
Workbooks.Add
ActiveSheet.Name = "Open SR Report"
Application.DisplayAlerts = False
Sheets("Sheet2").Select
ActiveSheet.Delete
Sheets("Sheet3").Select
ActiveSheet.Delete
Application.DisplayAlerts = True
NewWorkbook = ActiveWorkbook.Name
Workbooks(StartWorkbook).Activate
Sheets(StartSheet).Select
'Start search in row 4
LSearchRow = 4
'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 3
While Len(Range("A" & CStr(LSearchRow)).Value) > 0
If Range("C" & CStr(LSearchRow)).Value <> "Closed" Then
'If value in column E = the selected portfolio, copy entire row to Sheet2
If Range("J" & CStr(LSearchRow)).Value = word Then
'Select row in Sheet to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Sheet in next row
Workbooks(NewWorkbook).Activate
Sheets("Open SR Report").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
Workbooks(StartWorkbook).Activate
'Move counter to next row
LCopyToRow = LCopyToRow + 1
'Go back to continue searching
Sheets(StartSheet).Select
End If
End If
LSearchRow = LSearchRow + 1
Wend
Rows("3:3").Copy
Workbooks(NewWorkbook).Activate
Rows("2:2").Select
ActiveSheet.Paste
Columns("D:F").ColumnWidth = 2.14
Range("E:F,H:H,J:L,N:N,V:V,AE:AG,AJ:AK,AM:AN,AP:AP").EntireColumn.Hidden = True
Range("U2,Y2,AH2").ClearComments
Rows("1:1").RowHeight = 61.5
Rows("2:2").EntireRow.AutoFit
Rows("2:2").Select
With Selection
.VerticalAlignment = xlCenter
End With
With Selection.Font
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveWindow.DisplayGridlines = False
Columns("B:B").ColumnWidth = 8
Columns("C:C").ColumnWidth = 9
Columns("I:I").ColumnWidth = 9
Columns("P:P").ColumnWidth = 11
Columns("Q:Q").ColumnWidth = 25.86
Columns("U:U").ColumnWidth = 50
Columns("T:T").ColumnWidth = 25
Cells.Select
Selection.FormatConditions.Delete
Selection.Interior.ColorIndex = xlNone
Workbooks(StartWorkbook).Activate
Sheet6.Visible = xlSheetVisible
Sheets("logos").Select
ActiveSheet.Shapes.Range(Array("Picture 2", "Text Box 1", "Picture 3")).Select
Selection.Copy
Sheet6.Visible = xlSheetVeryHidden
Sheets("SRs").Select
Workbooks(NewWorkbook).Activate
Range("A1").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 50.25
Selection.ShapeRange.IncrementTop -24.75
Selection.ShapeRange.IncrementLeft 0.75
Selection.ShapeRange.IncrementTop -0.75
Range("B1:S1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 41
End With
Range("A2:AO2").Select
With Selection.Borders(xlInsideVertical)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B3").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Your Open SR Report is complete."
Exit Sub
' Err_Execute:
' MsgBox "An error occurred."
End Sub