Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel 2007 VBA shape fill colour problem
I have a generic VBA routine that adds a specified shape to each cell within
a target range on a worksheet and defines the Shape.Fill.ForeColor.SchemeColor property and the OnAction event. The OnAction event routine then toggles the Shape.Fill.Visible property on and off which should change the colour to the already defined Shape.Fill.ForeColor.SchemeColor property and back again, but the colour always defaults to turquoise rather than the colour I've specified. The code detailed below worked fine in Excel 2003, this appears to be a bug in 2007. -------------------------------------------- Worksheet code (sheet1 in this instance). Run sub TestAddMarkers to add the worksheet shapes which you can then click to run the OnAction code. Option Explicit Public Sub TestAddMarkers() Marker_AddMarkers Sheet1.Range("A1:A5"), "Sheet1.ToggleMarker" End Sub Public Sub ToggleMarker() Marker_HandleMarkerClick Sheet1.Shapes(Application.Caller) Marker_SetMarkersInRange Sheet1.Range("A1:A5") End Sub ----------------------------------------------- Module level code detailed below... Option Explicit Public Enum tColorIndex ' Colors are in same order as on color pallete, down and across mxlAutomaticColor = 0 mxlNoColor = -4142 mxlBlack = 1 mxlDarkRed = 9 mxlRed = 3 mxlPink = 7 mxlRose = 38 mxlBrown = 53 mxlOrange = 46 mxlLightOrange = 45 mxlGold = 44 mxlTan = 40 mxlOliveGreen = 52 mxlDarkYellow = 12 mxlLime = 43 mxlYellow = 6 mxlLightYellow = 36 mxlDarkGreen = 51 mxlGreen = 10 mxlSeaGreen = 50 mxlBrightGreen = 4 mxlLightGreen = 35 mxlDarkTeal = 49 mxlTeal = 14 mxlAqua = 42 mxlTurquoise = 8 mxlLightTurquoise = 34 mxlDarkBlue = 11 mxlBlue = 5 mxlLightBlue = 41 mxlSkyBlue = 33 mxlPaleBlue = 37 mxlIndigo = 55 mxlBlueGray = 47 mxlViolet = 13 mxlPlum = 54 mxlLavender = 39 mxlGray80 = 56 mxlGray50 = 16 mxlGray40 = 48 mxlGray25 = 15 mxlWhite = 2 ' Chart Fill colors as shown on the color palatte mxlChartFillPastelBlue = 17 mxlChartFillPlum = 18 mxlChartFillLightTan = 19 mxlChartFillLightTurquoise = 20 mxlChartFillDarkViolet = 21 mxlChartFillPastelPink = 22 mxlChartFillDarkerLightBlue = 23 mxlChartFillLightBueGray = 24 ' Chart Line colors as shown on the color palatte mxlChartLineDarkBlue = 25 mxlChartLinePink = 26 mxlChartLineYellow = 27 mxlChartLineTurquoise = 28 mxlChartLineViolet = 29 mxlChartLineDarkRed = 30 mxlChartLineTeal = 31 mxlChartLineBlue = 32 ' Shape scheme colors mxlSchemeColorBlack = 8 mxlSchemeColorDarkRed = 16 mxlSchemeColorRed = 10 mxlSchemeColorPink = 14 mxlSchemeColorRose = 45 mxlSchemeColorBrown = 60 mxlSchemeColorOrange = 53 mxlSchemeColorLightOrange = 52 mxlSchemeColorGold = 51 mxlSchemeColorTan = 47 mxlSchemeColorOliveGreen = 59 mxlSchemeColorDarkYellow = 19 mxlSchemeColorLime = 50 mxlSchemeColorYellow = 13 mxlSchemeColorLightYellow = 43 mxlSchemeColorDarkGreen = 58 mxlSchemeColorGreen = 17 mxlSchemeColorSeaGreen = 57 mxlSchemeColorBrightGreen = 11 mxlSchemeColorLightGreen = 42 mxlSchemeColorDarkTeal = 56 mxlSchemeColorTeal = 21 mxlSchemeColorAqua = 49 mxlSchemeColorTurquoise = 15 mxlSchemeColorLightTurquoise = 41 mxlSchemeColorDarkBlue = 18 mxlSchemeColorBlue = 12 mxlSchemeColorLightBlue = 48 mxlSchemeColorSkyBlue = 40 mxlSchemeColorPaleBlue = 44 mxlSchemeColorIndigo = 62 mxlSchemeColorBlueGray = 54 mxlSchemeColorViolet = 20 mxlSchemeColorPlum = 61 mxlSchemeColorLavender = 46 mxlSchemeColorGray80 = 63 mxlSchemeColorGray50 = 23 mxlSchemeColorGray40 = 55 mxlSchemeColorGray25 = 22 mxlSchemeColorWhite = 9 End Enum Public Sub Marker_AddMarkers( _ ByVal TargetRange As Range, _ ByVal ClickRoutineName As String _ ) ' Add markers to the range specified by the parameter TargetRange. Dim Cell As Range Dim Marker As Shape For Each Cell In TargetRange Cell.Font.ColorIndex = IIf(Cell.Interior.ColorIndex = mxlNoColor, mxlWhite, Cell.Interior.ColorIndex) If Len(Cell) = 0 Then Cell = False Set Marker = TargetRange.Parent.Shapes.AddShape(msoShapeRectang le, Cell.Left + 2, Cell.Top + 2, Cell.Height - 3.5, Cell.Height - 3.5) With Marker .Fill.Solid .Fill.Transparency = 0 .Line.Weight = 1.5 If Cell.Interior.ColorIndex = mxlGray25 Then .Line.ForeColor.SchemeColor = mxlSchemeColorGray80 Else .Line.ForeColor.SchemeColor = mxlSchemeColorGray25 End If .Fill.ForeColor.SchemeColor = mxlSchemeColorGray50 End With Marker.OnAction = ClickRoutineName Next Cell Marker_SetMarkersInRange TargetRange End Sub Public Function Marker_HandleMarkerClick( _ ByVal Marker As Shape _ ) Marker.TopLeftCell = Not Marker.TopLeftCell Marker.Fill.Visible = IIf(Marker.TopLeftCell, msoTrue, msoFalse) End Function Public Sub Marker_SetMarker( _ ByVal Marker As Shape _ ) Marker.Fill.Visible = IIf(Marker.TopLeftCell, msoTrue, msoFalse) End Sub Public Sub Marker_SetMarkersInRange( _ ByVal TargetRange As Range _ ) ' Set all markers in the range specified by the parameter TargetRange. Dim Shape As Shape For Each Shape In TargetRange.Parent.Shapes If Shape.Type = msoAutoShape Then If Shape.AutoShapeType = msoShapeRectangle Then If Not Intersect(TargetRange, Shape.TopLeftCell) Is Nothing Then Marker_SetMarker Shape End If End If Next Shape End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel 2007 VBA shape fill colour problem | Excel Programming | |||
Fill Colour problem | Excel Discussion (Misc queries) | |||
Excel 2007 Fill Problem | Excel Discussion (Misc queries) | |||
If I draw a shape in Excel (say a triangle), can I colour it? | Excel Worksheet Functions | |||
How can I change the default fill colour in excel 2007 | Excel Discussion (Misc queries) |