WILDCARDS - can you use them in code?

[itr674]

I use the following code to build commandbars from "prefixed" sheet names.

I need to add a "number" in the prefix, something like "saf1-Safety Schedules, saf2-Safety Problems" so I can get the sheets to show up in the control in predetermined order.

How do I filter out the numbers?<pre>Sub WS_Get_SAF()
On Error Resume Next
Set MenuObject = Application.CommandBars("CC Book").Controls("Safety")
' Delete existing "sheet" names but leaves hard coded controls in tack ...
For Each MenuItem In MenuObject.CommandBar.Controls
For Each WS In Worksheets
If Left(WS.Name, 3) = "saf" Then
' Remove the sheet suffix
strName = WorksheetFunction.Substitute(WS.Name, "saf-", "")
If strName = MenuItem.Caption Then MenuItem.Delete
End If
Next
Next
strActionName = ThisWorkbook.Name & "!GoToSAFSheets"
' Then add all sheets names meeting criteria
For Each WS In Worksheets
If Left(WS.Name, 3) = "saf" Then
' Remove the sheet name suffix
strName = WorksheetFunction.Substitute(WS.Name, "saf-", "")
MenuObject.Controls.Add(Before:=1).Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
End If
Next
Run "KillVariables"
On Error GoTo 0
End Sub</pre>
This message was edited by em on 2002-10-17 09:18
This message was edited by em on 2002-10-17 23:44

 

[itr674]

rikrak - If a sheet name is "tes1-Problems With Materials" how would I make the Like operator work or do I need something else?

What would I do to remove the prefix "tes1-" so only "Problems With Materials" shows up in the control and then what does it take to get the on-action code to work?

Can you give me a little traing on storing the number?<pre>hi em,


Sub GoToSAFSheets()
strCaller = "saf-#" & Application.CommandBars.ActionControl.Caption
Application.GoTo Sheets(strCaller).Range("A1"), True
End Sub


With what number has # to be substituted?
You have to store the original number somewhere to be able to substitute #.
I think this is not going to work this way.</pre>
This message was edited by em on 2002-10-19 20:57

 

[rikrak]

Hi em,

There's for each menuitem a property called DescriptionText, a nice place to store the original sheet name.

Add this line of code (the bold one) in the procedure that gets all the names:
MenuObject.Controls.Add(Before:=1).Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
MenuObject.Controls(strName).DescriptionText = WS.Name

Then all sub's as<pre>Sub GoToUDM_ListingsSheets()
Sub GoToUDM_InfoSheets()
Sub GoToWRMSheets()
Sub GoToINPSheets()
Sub GoToDEPSheets()
........</pre>
can be replaced by<pre>Sub GoTo_ListingsSheets()
strCaller = Application.CommandBars.ActionControl.DescriptionText
Application.Goto Sheets(strCaller).Range("A1"), True
End Sub</pre>
here the original sheet name is extracted from DescriptionText.


To point all the items to this new routine you have to change the strActionName in all sub's as:<pre>Sub WS_Get_UDMListings()
Sub WS_Get_UDMInfo()
Sub WS_Get_WRM()
.........</pre>
to:<pre>strActionName = ThisWorkbook.Name & "!GoTo_ListingsSheets"</pre>



What about that?
This message was edited by rikrak on 2002-10-20 08:26

 

[rikrak]

em,

You can also do some code reduction.
Insert this as a new sub into<u>WS_Getname</u> module:<pre>
Sub WS_Get_Listings(cntrl As String, suffix As String)
On Error Resume Next
Set MenuObject = Application.CommandBars("UDM").Controls(cntrl)
'Delete existing ones.
For Each MenuItem In MenuObject.CommandBar.Controls
MenuItem.Delete
Next
strActionName = ThisWorkbook.Name & "!GoTo_ListingsSheets"
'then add all meeting criteria
For Each WS In Worksheets
If InStr(WS.Name, suffix) Then
'Remove the suffix
strName = WorksheetFunction.Substitute(WS.Name, suffix, "")
MenuObject.Controls.Add(Before:=1).Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
MenuObject.Controls(strName).DescriptionText = WS.Name
End If
Next
On Error GoTo 0
End Sub</pre>
The code in the other sub's can then be reduce to:<pre>
Sub WS_Get_UDMListings()
WS_Get_Listings cntrl:="UDM Listings", suffix:="udl-"
End Sub
Sub WS_Get_UDMInfo()
WS_Get_Listings cntrl:="UDM Info", suffix:="udi-"
End Sub
Sub WS_Get_WRM()
WS_Get_Listings cntrl:="WRM", suffix:="wrm"
End Sub</pre>

Each sub calls<u>WS_Get_Listings</u> with the name of the menucontrol and suffix as parameters.
This way the code is easier to maintain.
This message was edited by rikrak on 2002-10-20 09:20

 

[itr674]

rikrak - thanks, thanks, thanks. I haven't tried the code yet, but I knew there was probably a way to shorten all this. I will plug and play your code later this afternoon ...

 

[itr674]

rikrak -- man did this shorten the code, I just can't believe how much it shortened it.

I loaded the code and it works perfectly except for the buttons that are made from the menu maker sheet. They are being deleted a long with the sheet names each time the control is pressed. I played with a couple to fixes but could not get them to work.

See line number 6 in the code (I added this line trying to get solution. The code must delete the menuitems that are sheet names only and not menuitems made from menu maker sheet ...

<pre>Sub WS_Get_Listings(cntrl As String, suffix As String)

On Error Resume Next
Set MenuObject = Application.CommandBars("UDM").Controls(cntrl)

'Delete existing ones.
For Each MenuItem In MenuObject.CommandBar.Controls
If MenuObject.Controls(strName).DescriptionText = MenuItem Then
MenuItem.Delete
End If
Next

strActionName = ThisWorkbook.Name & "!GoTo_ListingsSheets"
'then add all meeting criteria
For Each WS In Worksheets
If InStr(WS.Name, suffix) Then
'Remove the suffix
strName = WorksheetFunction.Substitute(WS.Name, suffix, "")
MenuObject.Controls.Add(Before:=1).Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
MenuObject.Controls(strName).DescriptionText = WS.Name
End If
Next
On Error GoTo 0

End Sub</pre>

 

[rikrak]

You are right em.
Replace it with this to remove only sheetnames.<pre>
If Instr(WS.Name, suffix)Then
' Remove the sheet suffix
strName = WorksheetFunction.Substitute(WS.Name, suffix, "")
If strName = MenuItem.Caption Then MenuItem.Delete</pre>



Edit: Check your PM please.
This message was edited by rikrak on 2002-10-20 13:48

 

[itr674]

rikrak -- just figured it out also. Man is this nice. I just can't believe how much code was saved. Thanks a bunch--heading for PM ..

Here is some of the finished code:

<pre>Sub WS_Get_Listings(cntrl As String, prefix As String)

On Error Resume Next
Set MenuObject = Application.CommandBars("CC Book").Controls(cntrl)

'Delete existing Worksheet names but not hard coded buttons
For Each MenuItem In MenuObject.CommandBar.Controls
For Each WS In Worksheets
If InStr(WS.Name, prefix) Then
' Remove the sheet prefix
strName = WorksheetFunction.Substitute(WS.Name, prefix, "")
If strName = MenuItem.Caption Then MenuItem.Delete
End If
Next
Next

strActionName = ThisWorkbook.Name & "!GoTo_ListingsSheets"
'adds all worksheets meeting criteria
WSNum = 0
For Each WS In Worksheets
If InStr(WS.Name, prefix) Then
'Remove the prefix
strName = WorksheetFunction.Substitute(WS.Name, prefix, "")
WSNum = WSNum + 1 ' this ensures WS are at top of control in the order _
they appear in workbook AND puts hard coded controls at _
bottom of control. Divider is used to seperate the two ...
MenuObject.Controls.Add(Before:=WSNum).Caption = strName
MenuObject.Controls(strName).OnAction = strActionName
MenuObject.Controls(strName).DescriptionText = WS.Name
End If
Next
On Error GoTo 0

End Sub</pre>

A COUPLE OD THE On-Action Macros

<pre>Sub WS_Get_FIL()
WS_Get_Listings cntrl:="File Maint", prefix:="fil-"
End Sub
Sub WS_Get_UDMListings()
WS_Get_Listings cntrl:="UDM Listings", prefix:="udl-"
End Sub</pre>