PDA

View Full Version : [SOLVED] Need help to shorten The DeleteEdsMenuItems



Erays
04-13-2005, 02:22 PM
Sub BuildEdsMenuItem()
EdsMenu "Create Rei Folders", "MakeEdsFolder"
EdsMenu "Initial Email and Save", "EmailRei"
EdsMenu "Supplement Email and Save", "EmailSupp"
EdsMenu "TotalLoss Email and Save", "EmailTLA"
EdsMenu "Save Initial Rei", "SaveRei"
EdsMenu "Save Supplement Rei", "SaveSupp"
EdsMenu "Save Total Loss Rei", "SaveTotal"
End Sub
Public Function EdsMenu(vCaption As String, vOnAction As String)
Dim ctrl As CommandBarControl
On Error Resume Next
Application.CommandBars("Tools").Controls(vCaption).Delete
On Error GoTo 0
With Application.CommandBars("Worksheet Menu Bar").Controls("Tools").Controls.Add
.Caption = vCaption
.OnAction = vOnAction
End With
End Function


Sub DeleteEdsMenuItem()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Create Rei Folders" Then ctrl.Delete
Next
DeleteEdsMenuItem1
End Sub

Sub DeleteEdsMenuItem1()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Initial Email and Save" Then ctrl.Delete
Next
DeleteEdsMenuItem2
End Sub

Sub DeleteEdsMenuItem2()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Supplement Email and Save" Then ctrl.Delete
Next
DeleteEdsMenuItem3
End Sub

Sub DeleteEdsMenuItem3()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "TotalLoss Email and Save" Then ctrl.Delete
Next
DeleteEdsMenuItem4
End Sub

Sub DeleteEdsMenuItem4()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Save Initial Rei" Then ctrl.Delete
Next
DeleteEdsMenuItem5
End Sub

Sub DeleteEdsMenuItem5()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Save Supplement Rei" Then ctrl.Delete
Next
DeleteEdsMenuItem6
End Sub

Sub DeleteEdsMenuItem6()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools").Controls
If ctrl.Caption = "Save Total Loss Rei" Then ctrl.Delete
Next
End Sub

Killian
04-13-2005, 03:05 PM
Hi there :hi:
I was thinking that arrays are very quick for using to loop through a number of values so I though one for this.
Then I thought, if theres one for that captions, why not give it another dimension for the action command and have two simple loops for build and delete?


'array at module level
Dim arrMenuItem(6, 1) As String

Sub FillEdsMenuItemArray()
arrMenuItem(0, 0) = "Create Rei Folders"
arrMenuItem(1, 0) = "Initial Email and Save"
arrMenuItem(2, 0) = "Supplement Email and Save"
arrMenuItem(3, 0) = "TotalLoss Email and Save"
arrMenuItem(4, 0) = "Save Initial Rei"
arrMenuItem(5, 0) = "Save Supplement Rei"
arrMenuItem(6, 0) = "Save Total Loss Rei"
arrMenuItem(0, 1) = "MakeEdsFolder"
arrMenuItem(1, 1) = "EmailRei"
arrMenuItem(2, 1) = "EmailSupp"
arrMenuItem(3, 1) = "EmailTLA"
arrMenuItem(4, 1) = "SaveRei"
arrMenuItem(5, 1) = "SaveSupp"
arrMenuItem(6, 1) = "SaveTotal"
End Sub

Sub BuildEdsMenuItem_K()
With Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools")
For i = 0 To 6
With .Controls.Add
.Caption = arrMenuItem(i, 0)
.OnAction = arrMenuItem(i, 1)
End With
Next
End With
End Sub

Sub DeleteEdsMenuItem_K()
With Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools")
For i = 0 To 6
On Error Resume Next
.Controls(arrMenuItem(i, 0)).Delete
Next
End With
End Sub

Erays
04-13-2005, 04:18 PM
When I run this macro I get an error at i


For i = 0 To 6

Jacob Hilderbrand
04-13-2005, 06:03 PM
Works for me. Make sure you run the macro FillEdsMenuItemArray first to set the array values.

Also the variables are not all declared so if you have Option Explicit you will get an error.


Dim i As Long

Erays
04-13-2005, 06:37 PM
Thanks to all who have contributed here is the working script!



'array at module level
Dim arrMenuItem(6, 1) As String

Sub FillEdsMenuItemArray()
arrMenuItem(0, 0) = "Create Rei Folders"
arrMenuItem(1, 0) = "Initial Email and Save"
arrMenuItem(2, 0) = "Supplement Email and Save"
arrMenuItem(3, 0) = "TotalLoss Email and Save"
arrMenuItem(4, 0) = "Save Initial Rei"
arrMenuItem(5, 0) = "Save Supplement Rei"
arrMenuItem(6, 0) = "Save Total Loss Rei"

arrMenuItem(0, 1) = "MakeEdsFolder"
arrMenuItem(1, 1) = "EmailRei"
arrMenuItem(2, 1) = "EmailSupp"
arrMenuItem(3, 1) = "EmailTLA"
arrMenuItem(4, 1) = "SaveRei"
arrMenuItem(5, 1) = "SaveSupp"
arrMenuItem(6, 1) = "SaveTotal"
BuildEdsMenuItem_K
End Sub

Sub BuildEdsMenuItem_K()
Dim i As Long
With Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools")
For i = 0 To 6
With .Controls.Add
.Caption = arrMenuItem(i, 0)
.OnAction = arrMenuItem(i, 1)
End With
Next
End With
End Sub

Sub DeleteEdsMenuItem_K()
Dim i As Long
With Application.CommandBars("Worksheet Menu Bar") _
.Controls("Tools")
For i = 0 To 6
On Error Resume Next
.Controls(arrMenuItem(i, 0)).Delete
Next
End With
End Sub