Heloo
Can anyone plzz help me to get this code below working.....All I am looking for is to add another button to custom format toolbar and put my own format.....Any ideas help greatly appreciated...

Sub MakeCustomFormatDisplay()
Dim Tbar As CommandBar
Dim NewBtn As CommandBarButton
On Error Resume Next
CommandBars("Custom Format").Delete
On Error GoTo 0

Set Tbar = CommandBars.Add
With Tbar
..Name = "Custom Format"
..Visible = True
End With
Set NewBtn = CommandBars("Custom Format").Controls.Add(Type:=msoControlButton)
With NewBtn
..Caption = " "
..OnAction = "FormatChanger"
..TooltipText = "Click to change the Custom format"
..Style = msoButtonCaption
End With
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
On Error Resume Next
CommandBars("Custom Format").Controls(1).Caption = ActiveCell.CustomFormat
End Sub
Sub FormatChanger()
Dim r As Range

For Each r In Selection

Select Case r.Value
Case 1
r.Value = "Read Only"
Case 2
r.Value = "Assessor"
Case 3
r.Value = "Reviewer"

End Select

Next

Call UpdateToolbar
End Sub

I changed the last to this:

Sub FormatChanger()
Dim r As Range

For Each r In Selection

If IsNumeric(r.Value) Then
Select Case r.Value
Case 1
r.Value = "Read Only"
Case 2
r.Value = "Assessor"
Case 3
r.Value = "Reviewer"

End Select
End If
Next

Call UpdateToolbar
End Sub

Other than that, it worked ok for me.

I am not sure what UpdateToolbar is supposed to do or what
activecell.customformat is supposed to produce.

--
Regards,
Tom Ogilvy

"excelnaive" wrote in message
...
Heloo,
Can anyone plzz help me to get this code below
working.....All I am looking for is to add another button to custom format
toolbar and put my own format.....Any ideas help greatly appreciated...


Sub MakeCustomFormatDisplay()
Dim Tbar As CommandBar
Dim NewBtn As CommandBarButton
On Error Resume Next
CommandBars("Custom Format").Delete
On Error GoTo 0

Set Tbar = CommandBars.Add
With Tbar
.Name = "Custom Format"
.Visible = True
End With
Set NewBtn = CommandBars("Custom
Format").Controls.Add(Type:=msoControlButton)
With NewBtn
.Caption = " "
.OnAction = "FormatChanger"
.TooltipText = "Click to change the Custom format"
.Style = msoButtonCaption
End With
Call UpdateToolbar
End Sub
Sub UpdateToolbar()
On Error Resume Next
CommandBars("Custom Format").Controls(1).Caption = ActiveCell.CustomFormat
End Sub
Sub FormatChanger()
Dim r As Range

For Each r In Selection

Select Case r.Value
Case 1
r.Value = "Read Only"
Case 2
r.Value = "Assessor"
Case 3
r.Value = "Reviewer"

End Select

Next

Call UpdateToolbar
End Sub

Hi Tom
Thanks for the reply....I am trying to add another button to the custom format menu that stores my format which 1-read only,2-assessor,3-reviewer.I got this code from a excel book which talked about assigning a custom format to a built in button thats why I have the toolbar thing....I am not sure if my code is correct or not...but this is what I want to get....Any advices revisions greatly appreciated...

Thanks again...

----- Tom Ogilvy wrote: ----

I changed the last to this

Sub FormatChanger(
Dim r As Rang

For Each r In Selectio

If IsNumeric(r.Value) The
Select Case r.Valu
Case
r.Value = "Read Only
Case
r.Value = "Assessor
Case
r.Value = "Reviewer

End Selec
End I
Nex

Call UpdateToolba
End Su

Other than that, it worked ok for me

I am not sure what UpdateToolbar is supposed to do or wha
activecell.customformat is supposed to produce

--
Regards
Tom Ogilv

"excelnaive" wrote in messag
..
Heloo
Can anyone plzz help me to get this code belo
working.....All I am looking for is to add another button to custom forma
toolbar and put my own format.....Any ideas help greatly appreciated..
Sub MakeCustomFormatDisplay(
Dim Tbar As CommandBa
Dim NewBtn As CommandBarButto
On Error Resume Nex
CommandBars("Custom Format").Delet
On Error GoTo
Set Tbar = CommandBars.Ad
With Tba
.Name = "Custom Format
.Visible = Tru
End Wit
Set NewBtn = CommandBars("Custo
Format").Controls.Add(Type:=msoControlButton
With NewBt
.Caption = "
.OnAction = "FormatChanger
.TooltipText = "Click to change the Custom format
.Style = msoButtonCaptio
End Wit
Call UpdateToolba
End Su
Sub UpdateToolbar(
On Error Resume Nex
CommandBars("Custom Format").Controls(1).Caption = ActiveCell.CustomForma
End Su
Sub FormatChanger(
Dim r As Rang
For Each r In Selectio
Select Case r.Valu
Case
r.Value = "Read Only
Case
r.Value = "Assessor
Case
r.Value = "Reviewer
End Selec
Nex
Call UpdateToolba
End Su