Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
how to crerat star rating in a cell
i need in excel cell value change in star rating like windows media player
rating ( like 5 star change the value depent colour changes) |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
how to crerat star rating in a cell
Use CHAR(182) with the Wingdings font.
-- Gary''s Student - gsnu200732 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
how to crerat star rating in a cell
Just to add to Gary''s Student's response.
If you put the number in a separate cell (say A1), you can use a formula like: =REPT(CHAR(182),A1) (still formatted with Wingdings) This actually displays multiple stars. If you want to format each star (character by character, no half stars), you can't use a formula and you have to select the characters in the formula bar, then format|cells and change the font color. vinodks wrote: i need in excel cell value change in star rating like windows media player rating ( like 5 star change the value depent colour changes) -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
how to crerat star rating in a cell
Hi
Or you could do it with code, this will show five blank stars when you click on a cell with a value in column A you can then click on the 3rd star to give that cell a 3 star rating which will show as 3 gold stars. paste the following code in the This workbook module Option Explicit Private Sub Workbook_Open() Sheet1.RemoveStars End Sub then paste this code in the module in sheet1, add a few entries to column A then give them a rating by selecting them Option Explicit Dim ShapeCnt As Long Dim LCoord, TCoord As Long Dim Grade, i As Long Dim Star, Star1, Star2, Star3, Star4, Star5 As Shape Private Sub Worksheet_Activate() [B:B].Font.ColorIndex = 2 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) With ActiveSheet If Target.Column 1 Then RemoveStars Exit Sub End If If Target.Count 1 Then RemoveStars Exit Sub End If If Target.Value = "" Then RemoveStars Exit Sub End If LCoord = Target.Offset(0, 1).Left TCoord = Target.Offset(0, 1).Top ShapeCnt = Shapes.Count If ShapeCnt 0 Then RemoveStars AddStars Else AddStars End If End With End Sub Sub RemoveStars() With ActiveSheet ShapeCnt = Shapes.Count If ShapeCnt 0 Then Shapes.SelectAll Selection.Delete End If End With End Sub Sub AddStars() With ActiveSheet Set Star1 = Shapes.AddShape(msoShape5pointStar, LCoord, TCoord, 10, 10) Star1.Name = "Star1" Star1.OnAction = "Sheet1.ClickStar1" Set Star2 = Shapes.AddShape(msoShape5pointStar, LCoord + 12, TCoord, 10, 10) Star2.Name = "Star2" Star2.OnAction = "Sheet1.ClickStar2" Set Star3 = Shapes.AddShape(msoShape5pointStar, LCoord + 24, TCoord, 10, 10) Star3.Name = "Star3" Star3.OnAction = "Sheet1.ClickStar3" Set Star4 = Shapes.AddShape(msoShape5pointStar, LCoord + 36, TCoord, 10, 10) Star4.Name = "Star4" Star4.OnAction = "Sheet1.ClickStar4" Set Star5 = Shapes.AddShape(msoShape5pointStar, LCoord + 48, TCoord, 10, 10) Star5.Name = "Star5" Star5.OnAction = "Sheet1.ClickStar5" End With ColouredStars End Sub Sub ColouredStars() Grade = ActiveCell.Offset(0, 1).Value For Each Star In ActiveSheet.Shapes i = Right(Star.Name, 1) If i <= Grade Then Star.Fill.PresetGradient msoGradientDiagonalUp, 1, msoGradientGold End If Next Star End Sub Sub ClearStars() For Each Star In ActiveSheet.Shapes Star.Fill.Solid Star.Fill.ForeColor.SchemeColor = 9 Next Star ColouredStars End Sub Sub ClickStar1() ActiveCell.Offset(0, 1).Value = 1 ClearStars End Sub Sub ClickStar2() ActiveCell.Offset(0, 1).Value = 2 ClearStars End Sub Sub ClickStar3() ActiveCell.Offset(0, 1).Value = 3 ClearStars End Sub Sub ClickStar4() ActiveCell.Offset(0, 1).Value = 4 ClearStars End Sub Sub ClickStar5() ActiveCell.Offset(0, 1).Value = 5 ClearStars End Sub Hope this is of some use to you S |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Create rating with coloring cell | Excel Discussion (Misc queries) | |||
Compute a rating of a mtd average compared to a rating scale | Excel Discussion (Misc queries) | |||
Get Holidays in cell/s between star & End dates? | Excel Worksheet Functions | |||
Locate files using star name search and pull a cell from each | Excel Discussion (Misc queries) | |||
Some Excel spreadsheet cells have a red star on the left side of the cell | Excel Discussion (Misc queries) |