Excel 2007 Chart colorindex?
in [Programming]
|
From: L_P on 9 Dec 2009 14:21 Peter T;582075 Wrote: > > I can only assume something simple your end is going wrong here. > Absolutely > no reason why the "text" works and yet the same in a string variable > fails. > I agree. Yet this is precisely what is happening. The VBA routine - using the same code and variables and values - worked fine under the older version but failed under 2007. I checked in the debugger - replacing the String variable in SeriesCollection(<var>) with its exact value, as shown by the debugger, (thus SeriesCollection("value")) made the error go away. My current kludge to avoid this is to pass the collection and the series name to a subroutine, scroll through the names, find the one that matches, and return the index. SeriesCollection(<index>) works fine. But this kludgieness does not make my bunny hop. Peter T;582075 Wrote: > > In all versions "Pattern" is probably going to be wrong. There are > different > 'sets' of patterns for cells and chart formats, with many more > available for > the latter. > If I suss this out rightly, the "default" pattern set for the chart Interior settings and the cell Interior settings are the same. At any rate, this portion seems to work (after a fashion) As long as I don't change those settings (nor let the user do so), am I safe? I should like to minimize the amount of VBA-inspired slow-down this sheet causes. It does seem to be the case that, in the Series, changing the values within the Interior data structure automatically update the values within the Fill structure appropriately. In this way, got it working (well enough) via Interior: a chief problem seemed to be that the graph was treating foreground and background colors as switched, in comparison to the cells, when there was a pattern applied, but not when there was no pattern. Perhaps this reflects the pattern inconsistency to which you referred? Replacing the call to members of Interior with calls to members of Fill didn't really change anything (at least not apparently), though it's obviously neater to refer to the more appropriate part of the structure. Here is code that works, albeit a bit kludgily again - and perhaps not immune to changes which would get the different internal lookup tables for cells and graphs out of synch. I think the variables are clear enough from their names; Target is the range object which contains the desired formatting. Code: -------------------- If (Application.Version < "12.0") Then ' pre-Excel 2007 ChartObj.SeriesCollection(SIndex).Interior.Pattern = Target.Interior.Pattern ChartObj.SeriesCollection(SIndex).Interior.PatternColorIndex = Target.Interior.PatternColorIndex ChartObj.SeriesCollection(SIndex).Interior.ColorIndex = Target.Interior.ColorIndex Else ChartObj.SeriesCollection(SIndex).Interior.Pattern = Target.Interior.Pattern If Target.Interior.Pattern = 1 Then ' Really obnoxious inconsistency ChartObj.SeriesCollection(SIndex).Format.Fill.ForeColor.RGB = Target.Interior.Color ChartObj.SeriesCollection(SIndex).Format.Fill.BackColor.RGB = Target.Interior.PatternColor Else ChartObj.SeriesCollection(SIndex).Format.Fill.ForeColor.RGB = Target.Interior.PatternColor ChartObj.SeriesCollection(SIndex).Format.Fill.BackColor.RGB = Target.Interior.Color End If ChartObj.SeriesCollection(SIndex).Format.Fill.Transparency = Transparency / 100 End If -------------------- So, granted that this works (as far as I can tell), how might it be made more robust? (In addition to the lookup table to coordinate between chart pattern codes, kept in .Format.Fill.Pattern and the cell pattern codes, kept in .Interior.Pattern) Or, provided those 2 patterns keep in synch (albeit with one being the "inverse" of the other), am I safe enough with this? Thanks, LP -- L_P ------------------------------------------------------------------------ L_P's Profile: 1286 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=157914 [url="http://www.thecodecage.com"]Microsoft Office Help[/url]
From: Peter T on 9 Dec 2009 16:37 "L_P" <L_P.42xyvd(a)thecodecage.com> wrote in message > > Peter T;582075 Wrote: >> >> I can only assume something simple your end is going wrong here. >> Absolutely >> no reason why the "text" works and yet the same in a string variable >> fails. >> > I agree. Yet this is precisely what is happening. Its fine for me, suggest try again in a new chart with differently named series > > The VBA routine - using the same code and variables and values - worked > fine under the older version but failed under 2007. > > I checked in the debugger - replacing the String variable in > SeriesCollection(<var>) with its exact value, as shown by the debugger, > (thus SeriesCollection("value")) made the error go away. > > My current kludge to avoid this is to pass the collection and the > series name to a subroutine, scroll through the names, find the one that > matches, and return the index. SeriesCollection(<index>) works fine. > > But this kludgieness does not make my bunny hop. Really shouldn't be necessary > >> >> In all versions "Pattern" is probably going to be wrong. There are >> different >> 'sets' of patterns for cells and chart formats, with many more >> available for >> the latter. >> > If I suss this out rightly, the "default" pattern set for the chart > Interior settings and the cell Interior settings are the same. At any > rate, this portion seems to work (after a fashion) The default is for no pattern in either chart formats or cells > > As long as I don't change those settings (nor let the user do so), am I > safe? I don't quite follow > I should like to minimize the amount of VBA-inspired slow-down this > sheet causes. Slow-down? VBA can do a lot of stuff to many charts in barely an eye-blink. If you've got a noticeble slow-down merely changing one chart something's wrong, or not optimized. > It does seem to be the case that, in the Series, changing the values > within the Interior data structure automatically update the values > within the Fill structure appropriately. I don't follow > In this way, got it working (well enough) via Interior: a chief problem > seemed to be that the graph was treating foreground and background > colors as switched, in comparison to the cells, when there was a pattern > applied, but not when there was no pattern. Perhaps this reflects the > pattern inconsistency to which you referred? Yes that's right, forgot about that. Only need to be concerned when two colours are involved. > > Replacing the call to members of Interior with calls to members of Fill > didn't really change anything (at least not apparently), though it's > obviously neater to refer to the more appropriate part of the > structure. If it works... > > Here is code that works, albeit a bit kludgily again - and perhaps not > immune to changes which would get the different internal lookup tables > for cells and graphs out of synch. I think the variables are clear > enough from their names; Target is the range object which contains the > desired formatting. > > > Code: > -------------------- > > If (Application.Version < "12.0") Then ' pre-Excel 2007 > ChartObj.SeriesCollection(SIndex).Interior.Pattern = > Target.Interior.Pattern > ChartObj.SeriesCollection(SIndex).Interior.PatternColorIndex = > Target.Interior.PatternColorIndex > ChartObj.SeriesCollection(SIndex).Interior.ColorIndex = > Target.Interior.ColorIndex > Else > ChartObj.SeriesCollection(SIndex).Interior.Pattern = > Target.Interior.Pattern > If Target.Interior.Pattern = 1 Then ' Really obnoxious > inconsistency > ChartObj.SeriesCollection(SIndex).Format.Fill.ForeColor.RGB = > Target.Interior.Color > ChartObj.SeriesCollection(SIndex).Format.Fill.BackColor.RGB = > Target.Interior.PatternColor > Else > ChartObj.SeriesCollection(SIndex).Format.Fill.ForeColor.RGB = > Target.Interior.PatternColor > ChartObj.SeriesCollection(SIndex).Format.Fill.BackColor.RGB = > Target.Interior.Color > End If > ChartObj.SeriesCollection(SIndex).Format.Fill.Transparency = Transparency > / 100 > End If > > -------------------- If Target.Interior.Pattern = 1 Then ... or xlNone ... or xlAutomatic there's only one colour to be concerned with, so ensure the chart format is solid. (easier to assign the pattern to a variable first) > So, granted that this works (as far as I can tell), how might it be > made more robust? (In addition to the lookup table to coordinate between > chart pattern codes, kept in .Format.Fill.Pattern and the cell pattern > codes, kept in .Interior.Pattern) Or, provided those 2 patterns keep in > synch (albeit with one being the "inverse" of the other), In Excel 2003 record a macro applying the 18 patterns in 18 cells, Make 48 rectangles (obviously with VBA !) and record a macro applying the 48 fill patterns Relate the 18 cell patterns to the best match shape patterns (will find perfect matches but not all) and make your lookup table. Note there's no UI for chart/shape patterns in 2007 though can be applied with code or Andy Pope's Fill pattern addin > am I safe enough with this? Afraid I've only rapidly scan read all the above - I suspect I've missed something - best to test and test again in both versions One more thing, be careful about declaring something like Dim sr as Series then writing sr.some..property.or.method that was introduced in 2007. It might fail to compile in earlier versions (even if doing If ver >= 12 then xl 20-07 stuff Else 2003 or earlier stuff). Not saying it will, just watch out for it. Regards, Peter T
From: L_P on 11 Dec 2009 19:06 Thanks for all the feedback Peter_T. I've been wrestling with it for a while now, and I think I've got it working. I post my code here so that other people can benefit from it. I've got a GetPatEquiv function which translates the pattern codes used in Interior structure to those used in the Format.Fill structure. These appear to be the closest approximations in Fill to the patterns used in the older Interior. Then I've got a CopyColor routine. Parameters: Destination - what is receiving the copied color. In pre-2007, this should be some structure which includes an "Interior" field. In 2007, this should be a structure which includes a Format.Fill structure. Target - the Range which has the desired colors in its Interior field Transparency - the % transparency to set the destination region under 2007 FakeTransparent - a flag to fake transparency in pre-2007 versions. It is possible to get a "fake" transparency onto a data series in some circumstances under prior versions by "pasting a shape" into it. This only works if the shape is a solid color - if it has a pattern this doesn't work. The "catch" I do for this is to treat the special case if we are (a) in pre-2007, (b) are requesting a transparency and (c) providing a solid color. In this case, I set the Target's color not to the Destination but to a special Shape object I have set aside for the purpose. This takes the same settings as the 2007 Format.Fill object does. Then I select the Destination and paste the newly-colored shape into it. Voila. Code: -------------------- Private Function GetPatEquiv(OldIndex As Integer) Select Case OldIndex Case xlPatternGray75 GetPatEquiv = msoPattern75Percent Case xlPatternGray50 GetPatEquiv = msoPattern50Percent Case xlPatternGray25 GetPatEquiv = msoPattern25Percent Case xlPatternGray16 GetPatEquiv = msoPattern20Percent Case xlPatternGray8 GetPatEquiv = msoPattern10Percent Case xlPatternHorizontal GetPatEquiv = msoPatternDarkHorizontal Case xlPatternVertical GetPatEquiv = msoPatternDarkVertical Case xlPatternDown GetPatEquiv = msoPatternDarkDownwardDiagonal Case xlPatternUp GetPatEquiv = msoPatternDarkUpwardDiagonal Case xlPatternChecker GetPatEquiv = msoPatternSmallCheckerBoard Case xlPatternSemiGray75 GetPatEquiv = msoPatternTrellis Case xlPatternLightHorizontal GetPatEquiv = msoPatternLightHorizontal Case xlPatternLightVertical GetPatEquiv = msoPatternLightVertical Case xlPatternLightDown GetPatEquiv = msoPatternLightDownwardDiagonal Case xlPatternLightUp GetPatEquiv = msoPatternLightUpwardDiagonal Case xlPatternGrid GetPatEquiv = msoPatternSmallGrid Case xlPatternCrissCross GetPatEquiv = msoPattern30Percent End Select End Function Private Sub CopyColor(Destination As Variant, Target As Range, Optional Transparency As Integer, Optional FakeTransparent As Boolean) Dim ApplyTo As Variant Dim TransPatch As Boolean Dim Solid As Boolean Dim SelCol As Integer, SelRow As Integer If (Target.Interior.Pattern = xlPatternNone) Or (Target.Interior.Pattern = xlPatternSolid) Then Solid = True Else Solid = False End If If (Val(Application.Version) < 12) And ((Not FakeTransparent) Or (Transparency = 0) Or (Not Solid)) Then Destination.Interior.Pattern = Target.Interior.Pattern Destination.Interior.PatternColorIndex = Target.Interior.PatternColorIndex Destination.Interior.ColorIndex = Target.Interior.ColorIndex Else If Val(Application.Version) < 12 Then TransPatch = True Set ApplyTo = ActiveSheet.Shapes("Transparency") Else TransPatch = False Set ApplyTo = Destination.Format ' 2007 keeps its editable Fill in here, not in plain old Fill End If If Solid Then ApplyTo.Fill.ForeColor.RGB = Target.Interior.Color ApplyTo.Fill.Solid Else ApplyTo.Fill.ForeColor.RGB = Target.Interior.PatternColor ApplyTo.Fill.BackColor.RGB = Target.Interior.Color ApplyTo.Fill.Patterned GetPatEquiv(Target.Interior.Pattern) End If ApplyTo.Fill.Transparency = Transparency / 100 If TransPatch Then SelCol = Selection.Cells(1, 1).Column SelRow = Selection.Cells(1, 1).Row ActiveSheet.Shapes("Transparency").Select Selection.Copy Destination.Paste ActiveSheet.Cells(SelRow, SelCol).Select End If End If End Sub -------------------- -- L_P ------------------------------------------------------------------------ L_P's Profile: 1286 View this thread: http://www.thecodecage.com/forumz/showthread.php?t=157914 [url="http://www.thecodecage.com"]Microsoft Office Help[/url]
From: Peter T on 14 Dec 2009 06:11
Your pattern look-up table appears fine, some of the "greys" not perfect but as close as you'll get. It's quicker for me to roll my own test rather than go through all yours, FYI here it is, try it in 2007 and earlier versions. Sub TestPatterns() ' requires Function GetPatEquiv() as posted in the thread by "L_P" Dim patCell As Long, patCht As Long Dim i As Long, clr As Long, clrP As Long, cx As Long, cxP As Long Dim shp As Shape Dim sr As Series Dim pt As Point Dim ver As Long Dim v ver = Val(Application.Version) On Error Resume Next ActiveSheet.ChartObjects.Delete On Error GoTo 0 Call GetTestSeries(sr) v = Array("dummy", 1, -4126, -4125, -4124, 17, 18, -4128, -4166, _ -4121, -4162, 9, 10, 11, 12, 13, 14, 15, 16) For i = 1 To 18 With Cells(1, i) patCell = v(i) With .Resize(2).Interior .Pattern = patCell .Color = Int(Rnd * 16777215) .PatternColor = Int(Rnd * 16777215) cx = .ColorIndex cxP = .PatternColorIndex clr = .Color clrP = .PatternColor End With patCht = GetPatEquiv(patCell) Set pt = sr.Points(i) If ver >= 12 Then If patCht Then pt.Fill.Patterned patCht pt.Format.Fill.ForeColor.RGB = clrP pt.Format.Fill.BackColor.RGB = clr Else pt.Fill.Solid pt.Format.Fill.ForeColor.RGB = clr End If Else If patCht Then pt.Fill.Patterned patCht pt.Fill.ForeColor.SchemeColor = cxP pt.Fill.BackColor.SchemeColor = cx Else pt.Fill.Solid pt.Fill.ForeColor.SchemeColor = cx End If End If End With Next End Sub Sub GetTestSeries(sr As Series) Dim i As Long Dim cht As Chart ReDim arr(1 To 18) For i = 1 To 18 arr(i) = 1 Next With Range("a3") Set cht = ActiveSheet.ChartObjects.Add(.Left, .Top, _ .Width * 18, .Height * 20).Chart End With Set sr = cht.SeriesCollection.NewSeries sr.Values = arr cht.ChartGroups(1).GapWidth = 9 cht.Legend.Delete With cht.Axes(xlValue) .MaximumScale = 1 .Delete End With End Sub I didn't look into your Transparency stuff. Don't forget too that it's not always straightforward to get the cell's "apparent" colours, which may be layered on top of it's interior RGB colours. Regards, Peter T "L_P" <L_P.43225b(a)thecodecage.com> wrote in message news:L_P.43225b(a)thecodecage.com... > > Thanks for all the feedback Peter_T. I've been wrestling with it for a > while now, and I think I've got it working. I post my code here so that > other people can benefit from it. > > I've got a GetPatEquiv function which translates the pattern codes used > in Interior structure to those used in the Format.Fill structure. These > appear to be the closest approximations in Fill to the patterns used in > the older Interior. > > Then I've got a CopyColor routine. > > Parameters: > > Destination - what is receiving the copied color. In pre-2007, this > should be some structure which includes an "Interior" field. In 2007, > this should be a structure which includes a Format.Fill structure. > > Target - the Range which has the desired colors in its Interior field > > Transparency - the % transparency to set the destination region under > 2007 > > FakeTransparent - a flag to fake transparency in pre-2007 versions. > > > It is possible to get a "fake" transparency onto a data series in some > circumstances under prior versions by "pasting a shape" into it. This > only works if the shape is a solid color - if it has a pattern this > doesn't work. > > The "catch" I do for this is to treat the special case if we are (a) in > pre-2007, (b) are requesting a transparency and (c) providing a solid > color. > > In this case, I set the Target's color not to the Destination but to a > special Shape object I have set aside for the purpose. This takes the > same settings as the 2007 Format.Fill object does. Then I select the > Destination and paste the newly-colored shape into it. Voila. > > > > Code: > -------------------- > > Private Function GetPatEquiv(OldIndex As Integer) > Select Case OldIndex > Case xlPatternGray75 > GetPatEquiv = msoPattern75Percent > Case xlPatternGray50 > GetPatEquiv = msoPattern50Percent > Case xlPatternGray25 > GetPatEquiv = msoPattern25Percent > Case xlPatternGray16 > GetPatEquiv = msoPattern20Percent > Case xlPatternGray8 > GetPatEquiv = msoPattern10Percent > Case xlPatternHorizontal > GetPatEquiv = msoPatternDarkHorizontal > Case xlPatternVertical > GetPatEquiv = msoPatternDarkVertical > Case xlPatternDown > GetPatEquiv = msoPatternDarkDownwardDiagonal > Case xlPatternUp > GetPatEquiv = msoPatternDarkUpwardDiagonal > Case xlPatternChecker > GetPatEquiv = msoPatternSmallCheckerBoard > Case xlPatternSemiGray75 > GetPatEquiv = msoPatternTrellis > Case xlPatternLightHorizontal > GetPatEquiv = msoPatternLightHorizontal > Case xlPatternLightVertical > GetPatEquiv = msoPatternLightVertical > Case xlPatternLightDown > GetPatEquiv = msoPatternLightDownwardDiagonal > Case xlPatternLightUp > GetPatEquiv = msoPatternLightUpwardDiagonal > Case xlPatternGrid > GetPatEquiv = msoPatternSmallGrid > Case xlPatternCrissCross > GetPatEquiv = msoPattern30Percent > End Select > End Function > > > Private Sub CopyColor(Destination As Variant, Target As Range, Optional > Transparency As Integer, Optional FakeTransparent As Boolean) > > Dim ApplyTo As Variant > Dim TransPatch As Boolean > Dim Solid As Boolean > Dim SelCol As Integer, SelRow As Integer > > If (Target.Interior.Pattern = xlPatternNone) Or (Target.Interior.Pattern > = xlPatternSolid) Then > Solid = True > Else > Solid = False > End If > > If (Val(Application.Version) < 12) And ((Not FakeTransparent) Or > (Transparency = 0) Or (Not Solid)) Then > Destination.Interior.Pattern = Target.Interior.Pattern > Destination.Interior.PatternColorIndex = > Target.Interior.PatternColorIndex > Destination.Interior.ColorIndex = Target.Interior.ColorIndex > Else > If Val(Application.Version) < 12 Then > TransPatch = True > Set ApplyTo = ActiveSheet.Shapes("Transparency") > Else > TransPatch = False > Set ApplyTo = Destination.Format ' 2007 keeps its editable Fill in here, > not in plain old Fill > End If > > If Solid Then > ApplyTo.Fill.ForeColor.RGB = Target.Interior.Color > ApplyTo.Fill.Solid > Else > ApplyTo.Fill.ForeColor.RGB = Target.Interior.PatternColor > ApplyTo.Fill.BackColor.RGB = Target.Interior.Color > ApplyTo.Fill.Patterned GetPatEquiv(Target.Interior.Pattern) > End If > ApplyTo.Fill.Transparency = Transparency / 100 > > If TransPatch Then > SelCol = Selection.Cells(1, 1).Column > SelRow = Selection.Cells(1, 1).Row > ActiveSheet.Shapes("Transparency").Select > Selection.Copy > Destination.Paste > ActiveSheet.Cells(SelRow, SelCol).Select > End If > > End If > End Sub > > -------------------- > > > -- > L_P > ------------------------------------------------------------------------ > L_P's Profile: 1286 > View this thread: > http://www.thecodecage.com/forumz/showthread.php?t=157914 > > [url="http://www.thecodecage.com"]Microsoft Office Help[/url] > |