Hello Robin,
Please place Auto shpas or bitmaps in the sheet1 before run this code.
'---------------------------------------------------------------------------
-----
Sub CreateToolbarMenu()
Dim lngCnt As Long, shp As Shape, sh As Worksheet
On Error Resume Next
Application.CommandBars("newToolbar").Delete
On Error GoTo 0
Set sh = Sheets(1) 'Change here to the worksheet for shapes
Application.CommandBars.Add(Name:="newToolbar", Temporary:=True).Visible
= True
With Application.CommandBars("newToolbar")
For lngCnt = 1 To sh.Shapes.Count
Set shp = sh.Shapes(lngCnt)
.Controls.Add Type:=msoControlButton
If shp.Type = 13 Or shp.Type = 7 Then
shp.CopyPicture Format:=xlBitmap
Else
shp.Copy
End If
With .Controls(lngCnt)
.PasteFace
.OnAction = "TestProc" & lngCnt
.Style = msoButtonlngCntnAndCaption
.Caption = "New Button" & lngCnt
.Tag = "my_toolbars"
.TooltipText = "PopHint" & lngCnt
End With
Next
End With
Set sh = Nothing
Set shp = Nothing
End Sub
Sub Auto_Close()
On Error Resume Next
Application.CommandBars("newToolbar").Delete
End Sub
Sub TestProc1()
MsgBox "Hello world"
End Sub
Sub TestProc2()
MsgBox "Hello world"
End Sub
--
Kind Regards
Colo
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
Colo of 'The Road of The Cell Masters' :)
URL:
http://www.interq.or.jp/sun/puremis/...astersLink.htm
/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
"Robin Clay" wrote in message
...
Greetings !
I have written some code (with a GREAT deal of much-
appreciated help from you guys !) to place a menu onto the
Command Bar.
I have attached some of the standard Icons to some menu
items, using e.g.
.Style = msoButtonIconAndCaption
.FaceId = 17
but I would like to create my own icons to go on other
menu items.
This requires
- code to actually create an icon
- code to identify each icon so created, and
- code to attach one such icon to a particular menu item
Please can SKS provide some samples of such coding ?
RClay AT haswell DOT com