dear swapnil
this coding is working and gives a POPUP MENU SHOWING number of
worksheets. Is there other way to add worksheets in a combobox in the
menu you created so that if we click that particular sheet we can
navigate to the clicked sheet using your menu
regards
manish

On Jun 3, 6:33 pm, Swapnil Palande <[email protected]> wrote:
> Hi Manish,
>
> Insert new module in project and copy...paste following code in it:
>
> Dim cbMainMenuBar As CommandBar
> Dim mytool As CommandBarControl
>
> Sub Auto_Open()
>     RemoveControl
>     Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
>     Set mytool = cbMainMenuBar.Controls.Add(Type:=msoControlPopup)
>     mytool.Caption = "&MyTools"
>
>     With mytool.Controls.Add(Type:=msoControlButton)
>         'str = "nSheets"
>         .Caption = "&Number Of Sheets"
>         .OnAction = "no_of_sheets"
>     End With
> End Sub
>
> Sub Auto_Close()
>     RemoveControl
> End Sub
>
> Private Sub RemoveControl()
>
> On Error Resume Next
> 'Application.CommandBars.FindControl(Tag:=cTag).Delete
> Application.CommandBars("Worksheet Menu Bar").Controls("MyTools").Delete
> End Sub
>
> Sub no_of_sheets()
> MsgBox (ActiveWorkbook.Sheets.Count)
> End Sub
>
> Please find attached excel for your reference
>
> Regards,
>
> Swapnil.
>
>
>
> On Thu, Jun 3, 2010 at 5:51 PM, manish <[email protected]> wrote:
> > im trying to create a commandbar menu object for worksheet with a
> > dropdown submenu which can count number and names of worksheets in any
> > active workbook.
> > the code i've written is as given bolow, it is not working?? dont know
> > why?? is there anybody who can help me with it
>
> > Sub myusershowmenu2()
> > Dim i As Integer
> > Dim myarray() As Variant
> > Dim mymenubar As CommandBar
> > Set mymenubar = CommandBars _
> >    .Add(Name:="Custom", Position:=msoBarTop, _
> >    Temporary:=True)
> > mymenubar.Visible = True
> > Set mymenuControl = mymenubar.Controls.Add(Type:=msoControlComboBox,
> > ID:=1)
> > With mymenuControl
> > For i = 1 To ActiveWorkbook.Worksheets.Count - 1
> > myarray() = ActiveWorkbook.Worksheets(i).Name
> >       .AddItem Text:=myarray(), Index:=i
> > Next i
> >    DropDownLines = i + 1
> >    .DropDownWidth = 75
> >    .ListHeaderCount = 0
> > End With
> > End Sub
>
> > thanks in advance
> > regards
> > manish k
>
> > --
>
> > ---------------------------------------------------------------------------­-------
> > Some important links for excel users:
> > 1. Follow us on TWITTER for tips tricks and links :
> >http://twitter.com/exceldailytip
> > 2. Join our LinkedIN group @http://www.linkedin.com/groups?gid=1871310
> > 3. Excel tutorials athttp://www.excel-macros.blogspot.com
> > 4. Learn VBA Macros athttp://www.quickvba.blogspot.com
> > 5. Excel Tips and Tricks athttp://exceldailytip.blogspot.com
>
> > To post to this group, send email to [email protected]
>
> > <><><><><><><><><><><><><><><><><><><><><><>
> > HELP US GROW !!
>
> > We reach over 7000 subscribers worldwide and receive many nice notes about
> > the learning and support from the group.Let friends and co-workers know they
> > can subscribe to group at
> >http://groups.google.com/group/excel-macros/subscribe
>
>
>
>  MyMacros_new_SP.xls
> 82KViewDownload- Hide quoted text -
>
> - Show quoted text -

-- 
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links : 
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
 
To post to this group, send email to [email protected]

<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!

We reach over 7000 subscribers worldwide and receive many nice notes about the 
learning and support from the group.Let friends and co-workers know they can 
subscribe to group at http://groups.google.com/group/excel-macros/subscribe

Reply via email to