Command Bar = need to delete only WS that are added to a con

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
I have modified Walkenbacks "MenuMaker" and everything works except one thing.

A menu is built on a custom command bar (bar is built on the fly), and in the process it runs a macro that gets all the sheet names that are prefixed with a code, and puts them under that menu button (popup). Now I also want several commandbar buttons under that same menu.

The problem is that the macro that gets the sheet names has a line that deletes them so they will not be duplicated every time you click the menu button.

I need for the buttons that are added to the menu to not be deleted everytime the button is clicked--I have tried several different things but nothing has worked.

I am attaching code for everyone to look at ...

THIS IS THE CODE THAT BUILDS THE MENU BUTTON ON A CUSTOM COMMAND BAR:<pre>Select Case MenuLevel
Case "Menu" '"1"' Add commander bar items
'Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars("UDM"). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
MenuObject.Caption = Caption
MenuObject.OnAction = Macro
If Divider Then MenuObject.BeginGroup = True

Case "MenuItem" '"2"' A Menu Items
If NextLevel = "SubMenuItem" Then
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = Macro
End If
MenuItem.Caption = Caption
If FaceId<> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True</pre>


THIS IS THE CODE THAT GETS THE SHEET NAMES:<pre>Option Explicit

Dim UDMcb As CommandBar
Dim ws As Worksheet
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object 'used in case 2 and 3 for items under menu
Dim SubMenuItem As CommandBarButton
Dim strName As String
Dim strActionName As String

Sub GetAll_UDM()
On Error Resume Next
Set MenuObject = Application.CommandBars("UDM").Controls("UDM Listings")
'Delete existing ones - THIS IS THE SECTION CAUSING THE PROBLEM
For Each MenuItem In MenuObject.CommandBar.Controls
MenuItem.Delete
Next
strActionName = ThisWorkbook.Name & "!GoToUDMSheet"
'then add all meeting criteria
For Each ws In Worksheets
If Left(ws.Name, 3) = "udm" Then
'Remove the suffix
strName = WorksheetFunction.Substitute(ws.Name, "udm-", "")
MenuObject.Controls.Add().Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
End If
Next
On Error GoTo 0
End Sub</pre>
This message was edited by em on 2002-10-13 12:41
This message was edited by em on 2002-10-13 14:07
This message was edited by em on 2002-10-14 16:22
This message was edited by em on 2002-10-14 16:24
This message was edited by em on 2002-10-18 01:28
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
Would there be away to write a If Then statement that would leave the MenuItems and SubMenuItems?

Create_CB model builts the command bar and
GetWS_Names gets the worksheet names.

I was thinking I might be able to write something like

<pre>'Delete existing ones.
If MenuLevel = "MenuItem" Or "SubMenuItem" Then
Nothing
Else
For Each MenuItem In MenuObject.CommandBar.Controls
MenuItem.Delete
Next</pre>

????????????
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
This is some more of the code that comes from the Create_CB module:

<pre> Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
Position = .Cells(Row, 3)
Macro = .Cells(Row, 4)
Divider = .Cells(Row, 5)
FaceId = .Cells(Row, 6)
NextLevel = .Cells(Row + 1, 1)
End With</pre>
 

itr674

Well-known Member
Joined
Apr 10, 2002
Messages
1,778
is there a way to write a state that would say something like

"if it is a worksheet name then delete else don't delete"???
 

Ivan F Moala

MrExcel MVP
Joined
Feb 10, 2002
Messages
4,209
Try intergarting this Function that will test
to see if it is a worksheet as defined in your code eg with the udm prefix.

<pre/>
Function IsWorkSheet(strName As String) As Boolean
Dim Ws As Worksheet

IsWorkSheet = True
On Error Resume Next
Set Ws = ThisWorkbook.Sheets(strName)
If Err Then IsWorkSheet = False

End Function
</pre>

Will return True if it is a worksheet.
eg.

<pre/>
Sub Tester()
MsgBox IsWorkSheet("Sheet3asaaaaasss3")
MsgBox IsWorkSheet("Sheet1")
End Sub
</pre>

I think your code will look something like;

<pre/>
Sub GetAll_UDM()
On Error Resume Next
Set MenuObject = Application.CommandBars("UDM").Controls("UDM Listings")
'Delete existing ones - THIS IS THE SECTION CAUSING THE PROBLEM
For Each MenuItem In MenuObject.CommandBar.Controls
If Not IsWorkSheet("udm" & MenuItem.Caption) Then
MenuItem.Delete
End If

</pre>
 

Forum statistics

Threads
1,144,767
Messages
5,726,177
Members
422,660
Latest member
mrsteele

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top