Custom CommandBar Images (is it possible?)
Vincent Collier
create my own image and assign it to menu item? And I need to keep this
image for future use. Or are such things not possible?
--
Regards,
Vincent M. Collier
(Email reply not requested, but to reply by email you know what to remove.)
Rob Bovey
The easiest way to do this is to place a copy of the bitmap you want to
use on a hidden worksheet in the workbook where you are building the command
bars. Then you add the picture as you are setting the control properties as
follows:
Worksheets("Sheet1").Shapes("MyPicture").CopyPicture
CommandBars("MyBar").Controls(1).PasteFace
--
Rob Bovey, MCSE
The Payne Consulting Group
http://www.payneconsulting.com
Vincent Collier wrote in message ...
Stephen Bullen
> I know how to assign built-in images to menu items (.FaceId = ##), but can I
> create my own image and assign it to menu item? And I need to keep this
> image for future use. Or are such things not possible?
My favourite method is to create the image as a bitmap in e.g. Paint, then
copy it and paste it onto a worksheet as a standard Excel Picture. When you
create your custom toolbar buttons, just copy the picture and PasteFace it
into the toolbar. See CellWatch.exe on my web site for an example (set
IsAddin to false to see the worksheet containing the pictures).
Regards
Stephen Bullen
Microsoft MVP - Excel
http://www.BMSLtd.co.uk
AMX4080
--George
FreeServe NewsGroup Server
I just solved this problem, with the help of this group (thanks all) and
here is my solution.
The above respondents are quite right that PasteFace is an easy solution.
The big question is how to get the images onto a hidden sheet (I happen to
use the "Versions" sheet) and make sure that they are the right size etc. I
think I have a neat solution which consists of the following steps.
1. Use a procedure to create the toolbar using built-in faces. As an aside I
usually use a procedure to Loop through faces until I find something which
is close to what I'm looking for. Code for "CreateToolbar" and
"LoopThroughFaces" shown below in case it helps.
2. Use the XL97 built-in button editor to change the current toolbar buttons
to what you want. To do this right click on the toolbar and choose
Customise, then right click on each icon and choose edit. Repeat this until
you have the toolbar as you want it to look.
3. Run the macro shown below "Capture_ButtonFaces" to copy the current icons
to your hidden sheet, deleting the existing ones first.
4. Amend "CreateToolbar" so that it uses the saved icons. I usually leave
the command to put the built-in icons first just in case the saved icons
load fails for some reason.
Hope this helps ... here's the code ...
Mick Jennings
Mi...@Jennings27.Freeserve.co.uk
{Declarations section}
Public ISEProBarFound As Boolean
Public bar As CommandBar
Public Btn As CommandBarButton
Public Shp As Shape
Public ISEProBar As CommandBar
Public Btn_AddItems As CommandBarButton ' Choose_Items
Public Btn_BlankLine As CommandBarButton ' NewLine
Public Btn_Snapshot As CommandBarButton ' Freeze
Public Btn_Discount As CommandBarButton ' SW_Discount
Public Btn_Remove As CommandBarButton ' Remove_Items
Public Btn_DelRow As CommandBarButton ' DelRow
Public Btn_Print As CommandBarButton ' Print_Spreadsheet
Public Btn_Copy As CommandBarButton ' Copy_To_Clipboard
Public Btn_Licences As CommandBarButton ' Change_Licences
Public Btn_RenameSheet As CommandBarButton ' RenameSheet
Public Btn_DelSheet As CommandBarButton ' DelSheet
Public Btn_Consolidate As CommandBarButton ' ConsolidateSheet
Public Const ButtonStyle As Long = msoButtonIconAndCaption
Sub Auto_Open()
WB_Protect_Off
Protect_Off
CreateToolbar
'LoopThroughFaces 1
Application.DisplayAlerts = False
Worksheets("NewProposal").Activate
Worksheets("NewProposal").Range("B1").Activate
If ActiveWorkbook.MultiUserEditing Then ActiveWorkbook.ExclusiveAccess
Application.DisplayAlerts = True
Show_AllItems = False
If UCase(ThisWorkbook.Name) = "NEW_PRO_.XLT" _
And Not ThisWorkbook.ReadOnly Then
UnHideAllSheets
Else
If ActiveCell.Value = "" Then
ActiveCell.Value = InputBox("Enter the Project Name ...")
End If
Protect_On
WB_Protect_On
End If
End Sub
Sub CreateToolbar()
ISEProBarFound = False
For Each bar In CommandBars
If bar.Name = "ISEPRO" Then
ISEProBarFound = True
Set ISEProBar = bar
End If
Next
If Not ISEProBarFound Then
Set ISEProBar = CommandBars _
.Add(Name:="ISEPRO", Position:=msoBarTop, _
Temporary:=True)
End If
With ISEProBar
.Visible = True
If Not ISEProBarFound Then
Set Btn_AddItems = .Controls.Add(Type:=msoControlButton)
Btn_AddItems.FaceId = 213
Worksheets("Versions").Shapes(1).CopyPicture
Btn_AddItems.PasteFace
Btn_AddItems.OnAction = "Choose_Items"
Btn_AddItems.Caption = "Add"
Btn_AddItems.TooltipText = "Add Items to NewProposal"
Btn_AddItems.Style = ButtonStyle
Set Btn_BlankLine = .Controls.Add(Type:=msoControlButton)
Btn_BlankLine.FaceId = 731
Worksheets("Versions").Shapes(2).CopyPicture
Btn_BlankLine.PasteFace
Btn_BlankLine.OnAction = "NewLine"
Btn_BlankLine.Caption = "Blank"
Btn_BlankLine.TooltipText = "Add a blank line into a section of
NewProposal"
Btn_BlankLine.Style = ButtonStyle
Set Btn_Snapshot = .Controls.Add(Type:=msoControlButton)
Btn_Snapshot.FaceId = 19
Worksheets("Versions").Shapes(3).CopyPicture
Btn_Snapshot.PasteFace
Btn_Snapshot.OnAction = "Freeze"
Btn_Snapshot.Caption = "Snapshot"
Btn_Snapshot.TooltipText = "Make a permanent copy of
NewProposal"
Btn_Snapshot.Style = ButtonStyle
Set Btn_Discount = .Controls.Add(Type:=msoControlButton)
Btn_Discount.FaceId = 383 ' OR 396 IS %
Worksheets("Versions").Shapes(4).CopyPicture
Btn_Discount.PasteFace
Btn_Discount.OnAction = "SW_Discount"
Btn_Discount.Caption = "Disc."
Btn_Discount.TooltipText = "Apply a discount to the ISE software
components of NewProposal"
Btn_Discount.Style = ButtonStyle
Set Btn_DelRow = .Controls.Add(Type:=msoControlButton)
Btn_DelRow.FaceId = 47
Worksheets("Versions").Shapes(5).CopyPicture
Btn_DelRow.PasteFace
Btn_DelRow.OnAction = "DelRow"
Btn_DelRow.Caption = "Del row"
Btn_DelRow.TooltipText = "Delete the current component from
NewProposal"
Btn_DelRow.Style = ButtonStyle
Set Btn_Remove = .Controls.Add(Type:=msoControlButton)
Btn_Remove.FaceId = 453
Worksheets("Versions").Shapes(6).CopyPicture
Btn_Remove.PasteFace
Btn_Remove.OnAction = "Remove_Items"
Btn_Remove.Caption = "Del Item"
Btn_Remove.TooltipText = "Remove one or more complete items from
NewProposal"
Btn_Remove.Style = ButtonStyle
Set Btn_Licences = .Controls.Add(Type:=msoControlButton)
Btn_Licences.FaceId = 1084
Worksheets("Versions").Shapes(7).CopyPicture
Btn_Licences.PasteFace
Btn_Licences.OnAction = "Change_Licences"
Btn_Licences.Caption = "Licences"
Btn_Licences.TooltipText = "Change the number of ISE Core
Software Licences"
Btn_Licences.Style = ButtonStyle
Set Btn_Print = .Controls.Add(Type:=msoControlButton)
Btn_Print.BeginGroup = True
Btn_Print.FaceId = 364
Worksheets("Versions").Shapes(8).CopyPicture
Btn_Print.PasteFace
Btn_Print.OnAction = "Print_Spreadsheet"
Btn_Print.Caption = "Print"
Btn_Print.TooltipText = "Print this Proposal"
Btn_Print.Style = ButtonStyle
Set Btn_Copy = .Controls.Add(Type:=msoControlButton)
Btn_Copy.FaceId = 626 ' or 593
Worksheets("Versions").Shapes(9).CopyPicture
Btn_Copy.PasteFace
Btn_Copy.OnAction = "Copy_To_Clipboard"
Btn_Copy.Caption = "Copy"
Btn_Copy.TooltipText = "Copy the client portion of this proposal
to the clipboard"
Btn_Copy.Style = ButtonStyle
Set Btn_RenameSheet = .Controls.Add(Type:=msoControlButton)
Btn_RenameSheet.BeginGroup = True
Btn_RenameSheet.FaceId = 488
Worksheets("Versions").Shapes(10).CopyPicture
Btn_RenameSheet.PasteFace
Btn_RenameSheet.OnAction = "RenameSheet"
Btn_RenameSheet.Caption = "Rename Sht"
Btn_RenameSheet.TooltipText = "Rename this Proposal"
Btn_RenameSheet.Style = ButtonStyle
Set Btn_DelSheet = .Controls.Add(Type:=msoControlButton)
Btn_DelSheet.FaceId = 67
Worksheets("Versions").Shapes(11).CopyPicture
Btn_DelSheet.PasteFace
Btn_DelSheet.OnAction = "DelSheet"
Btn_DelSheet.Caption = "Del Sht"
Btn_DelSheet.TooltipText = "Permanently delete this proposal"
Btn_DelSheet.Style = ButtonStyle
Set Btn_Consolidate = .Controls.Add(Type:=msoControlButton)
Btn_Consolidate.FaceId = 497
Worksheets("Versions").Shapes(12).CopyPicture
Btn_Consolidate.PasteFace
Btn_Consolidate.OnAction = "ConsolidateSheet"
Btn_Consolidate.Caption = "Consolidate"
Btn_Consolidate.TooltipText = "Consolidate the components for
this proposal"
Btn_Consolidate.Style = ButtonStyle
End If
End With
End Sub
Sub LoopThroughFaces(Optional face_no As Integer = 1)
Do
Btn_AddItems.FaceId = face_no
Btn_AddItems.Visible = True
response = MsgBox(CStr(face_no) & " : More ?", vbYesNo)
If response <> vbYes Then Exit Sub
face_no = face_no + 1
Loop
End Sub
Sub RemoveToolbar()
CommandBars("ISEPRO").Visible = False
CommandBars("ISEPRO").Delete
End Sub
Sub Auto_Close()
If UCase(ThisWorkbook.Name) = "NEW_PRO_.XLT" _
And Not ThisWorkbook.ReadOnly Then
HideAllSheets
ActiveSheet.Protect ("SHEFFIELD")
ActiveWorkbook.Protect ("SHEFFIELD")
Else
MsgBox ("Please remember to get your spreadsheets signed off as soon
as possible")
End If
RemoveToolbar
End Sub
Sub Capture_ButtonFaces() ' Manually run for design purposes only
Dim vRow As Integer
vRow = 1
' First delete existing shapes
For Each Shp In Worksheets("Versions").Shapes
Shp.Delete
Next Shp
'Then copy Button Pictures on in order
With ISEProBar
For Each Btn In CommandBars("ISEPro").Controls
Btn.CopyFace
Worksheets("Versions").Paste
Destination:=Worksheets("Versions").Cells(vRow, 10)
vRow = vRow + 1
Next Btn
End With
End Sub