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

[itr674]

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

 

[itr674]

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]

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]

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]

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>