View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.misc
chris chris is offline
external usenet poster
 
Posts: 17
Default Put Wingdings Characters in Toolbar button caption- IF POSSIBLE

I work at a firm where we are often tickmarking various line items we
get from clients to denote certain things. Using some code I found on
the web and modifying it to suit our purposes, I was able to create a
custom toolbar with a drop down list of available tickmarks. All of
our most common tickmarks our in wingdings. I want to try to make it
so the caption of the drop down buttons on the toolbar can show what
the tickmark is it will make. Write now, it just says, Tickmark 1,
Tickmark 2, etc. I did a couple computer science classes in high
school and college but can't think of any possible way to do this.
Please help if you know something!

Here is the code that creates the toolbar:
Option Explicit

Public Const ToolBarName As String = "T/M 2"
'===========================================
Sub Auto_Open()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNamess As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("Macro1", _
"Macro2", _
"Macro3", _
"Macro4", _
"Macro5", _
"Macro6", _
"Macro7", _
"Macro8", _
"Macro9", _
"Macro10")

CapNamess = Array("ITickmark 1", _
"Tickmark 2", _
"Tickmark 3", _
"Tickmark 4", _
"Tickmark 5", _
"Tickmark 6", _
"Tickmark 7", _
"Tickmark 8", _
"Tickmark 9", _
"Tickmark 10")

TipText = Array("T/M 1", _
"T/M 2", _
"T/M 3", _
"T/M 4", _
"T/M 5", _
"T/M 6", _
"T/M 7", _
"T/M 8", _
"T/M 9", _
"T/M 10")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating
With .Controls.Add(Type:=msoControlPopup, Befo=1)
.Caption = "Extra Tickmarks"
For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" &
MacNames(iCtr)
.Caption = CapNamess(iCtr) & " " & MacNames(iCtr)
.Style = msoButtonIconAndCaption
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)

End With
Next iCtr
End With
End With

End Sub

The functions it calls are the following:
'Created by Christopher Yust
'Email:
'Created on 7/6/06
Sub Macro1()
ActiveCell.FormulaR1C1 = "a"
With ActiveCell
.Font.Name = "Symbol"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro2()
ActiveCell.FormulaR1C1 = "z"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro3()
ActiveCell.FormulaR1C1 = "b"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro4()
ActiveCell.FormulaR1C1 = "d"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro5()
ActiveCell.FormulaR1C1 = "f"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro6()
ActiveCell.FormulaR1C1 = "a"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro7()
ActiveCell.FormulaR1C1 = "V"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro8()
ActiveCell.FormulaR1C1 = "Z"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro9()
ActiveCell.FormulaR1C1 = "u"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub
Sub Macro10()
ActiveCell.FormulaR1C1 = "v"
With ActiveCell
.Font.Name = "Wingdings"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Font.ColorIndex = 3
End With
End Sub

Thanks!!