Excel 2007 Chart colorindex?
 

I have a macro that changes colors in a bar chart. The following code worked
in Excel XP.

Sheets("Chart").SeriesCollection(1).Interior.Color Index = 5

This command crashes Excel 2007, and I've noticed that the ColorIndex
property does not ever appear to be a property of the SeriesCollection object
in Excel 2007.

Does anyone know how to control chart colors in Excel 2007?

Excel 2007 Chart colorindex?
 

Here is a macro I recorded in XL 2010 beta . It works in XL2007 with the
..ForeColor.Brightness statement commented out (or deleted)
best wishes
--
Bernard Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme



Sub Macro1()
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select

With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorAccent3 ' this sets the
colour
.ForeColor.TintAndShade = 0
' .ForeColor.Brightness = 0 ' comment this out
.Transparency = 0
.Solid
End With
End Sub



"Jay" wrote in message
...
I have a macro that changes colors in a bar chart. The following code
worked
in Excel XP.

Sheets("Chart").SeriesCollection(1).Interior.Color Index = 5

This command crashes Excel 2007, and I've noticed that the ColorIndex
property does not ever appear to be a property of the SeriesCollection
object
in Excel 2007.

Does anyone know how to control chart colors in Excel 2007?

Excel 2007 Chart colorindex?
 

That code should work fine in Excel 2007, and ColorIndex is indeed a
property of Series.Interior (but not simply SeriesCollection)

Although for legacy it works, in 2007 though the preferred way is along the
lines Bernard suggested, or say
sr.Format.Fill.ForeColor.ObjectThemeColor = xlThemeColorAccent1
or
sr.Format.Fill.ForeColor.RGB = 123456

where sr refers to the Series. However don't do that in earlier versions, or
if you do declare
sr As Object ' not As series
If Val(Application.version) = 12 then
Excel 2007 code
Else
pre Excel2007 code

What is "Chart"?
If a chart sheet maybe you mean "Chart1". If a chartobject on a sheet named
"Chart" maybe you mean to do

Sheets("Chart").ChartObjects(1).Chart.SeriesCollec tion(1).Interior.ColorIndex
= 5

Either way, Excel 2007 shouldn't have crashed, an error at most!

Regards,
Peter T



"Jay" wrote in message
...
I have a macro that changes colors in a bar chart. The following code
worked
in Excel XP.

Sheets("Chart").SeriesCollection(1).Interior.Color Index = 5

This command crashes Excel 2007, and I've noticed that the ColorIndex
property does not ever appear to be a property of the SeriesCollection
object
in Excel 2007.

Does anyone know how to control chart colors in Excel 2007?

Excel 2007 Chart colorindex?
 

I've got something similar under pre-2007, but rather than assigning an
explicit color value to the bars in my graph, I'm taking the value from
a specific cell. (This allows the user to configure the graph's
appearance).

This code works (or has under the pre-2007 versions I've tried it on):


Code:
--------------------

With <path.SeriesCollection(SeriesName)
.Interior.Pattern = Target.Interior.Pattern
.Interior.PatternColorIndex = Target.Interior.PatternColorIndex
.Interior.ColorIndex = Target.Interior.ColorIndex
End With

--------------------


Here, SeriesName holds the name of the data series being changed, and
Target is the Range (from the Excel sheet) which holds the desired
format.

But this is not working under 2007.

There appear to be 2 problems:


1) It doesn't want to accept SeriesName as a valid selector for
SeriesCollection. When I replace the variable with the explicit string
it works fine (e.g. replace the variable SeriesName with "Series1"),
even when that explicit string is the exact value of the string
variable. Is there some new flag to add?


2) The color doesn't change properly.

Now, I assume this is because, under 2007, the graph's colors are being
computed from different fields - RGB, ForeColor, etc. (As suggested by
the examples above).

How do I, under 2007, pick up the "fill" information out of the Target
range (background color and pattern) and apply that to the Series in the
graph?


thanks,
LP


--
L_P
------------------------------------------------------------------------
L_P's Profile: 1286
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=157914

Microsoft Office Help

Excel 2007 Chart colorindex?
 

See comments in-line -

"L_P" wrote in message

I've got something similar under pre-2007, but rather than assigning an
explicit color value to the bars in my graph, I'm taking the value from
a specific cell. (This allows the user to configure the graph's
appearance).

This code works (or has under the pre-2007 versions I've tried it on):


Code:
--------------------

With <path.SeriesCollection(SeriesName)
.Interior.Pattern = Target.Interior.Pattern
.Interior.PatternColorIndex = Target.Interior.PatternColorIndex
.Interior.ColorIndex = Target.Interior.ColorIndex
End With

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 you really want to copy the pattern you'll need to make a lookup table of
what pattern to apply to the chart that's similar in appearence to the cell
pattern. Bit of experimantation to make the table




Here, SeriesName holds the name of the data series being changed, and
Target is the Range (from the Excel sheet) which holds the desired
format.

But this is not working under 2007.

There appear to be 2 problems:


1) It doesn't want to accept SeriesName as a valid selector for
SeriesCollection. When I replace the variable with the explicit string
it works fine (e.g. replace the variable SeriesName with "Series1"),
even when that explicit string is the exact value of the string
variable. Is there some new flag to add?

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.


2) The color doesn't change properly.

Now, I assume this is because, under 2007, the graph's colors are being
computed from different fields - RGB, ForeColor, etc. (As suggested by
the examples above).

How do I, under 2007, pick up the "fill" information out of the Target
range (background color and pattern) and apply that to the Series in the
graph?

Although the 56 colour palette works in 2007 for compatibility, better for
what you're trying to do to use RGB colours, eg (sr refers to the series)

sr.Format.Fill.ForeColor.RGB = cell.Interior.Color

Before doing anything might want to ensure the series fill is solid, simply
sr.Format.Fill.Solid

Then if you want to apply a pattern (from the lookup table)
p = cell.Interior.Pattern
If p < 1 Or p < xlNone Or p < xlAutomatic then
get pattern-number from lookup using p then
sr.Fill.Patterned pattern-number
sr.Format.Fill.BackColor.RGB = cell.Interior.PatternColor

Note in Excel 2007 the cell's apparent fill colour might be from a Table
style of a conditional format - these will not be returned from the cell's
RGB format. Such a colour can be obtained but a lot more work.

Regards,
Peter T

Excel 2007 Chart colorindex?
 

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.Pattern ColorIndex = Target.Interior.PatternColorIndex
ChartObj.SeriesCollection(SIndex).Interior.ColorIn dex = 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.Fore Color.RGB = Target.Interior.Color
ChartObj.SeriesCollection(SIndex).Format.Fill.Back Color.RGB = Target.Interior.PatternColor
Else
ChartObj.SeriesCollection(SIndex).Format.Fill.Fore Color.RGB = Target.Interior.PatternColor
ChartObj.SeriesCollection(SIndex).Format.Fill.Back Color.RGB = Target.Interior.Color
End If
ChartObj.SeriesCollection(SIndex).Format.Fill.Tran sparency = 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/sh...d.php?t=157914

Microsoft Office Help

Excel 2007 Chart colorindex?
 

"L_P" 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.Pattern ColorIndex =
Target.Interior.PatternColorIndex
ChartObj.SeriesCollection(SIndex).Interior.ColorIn dex =
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.Fore Color.RGB =
Target.Interior.Color
ChartObj.SeriesCollection(SIndex).Format.Fill.Back Color.RGB =
Target.Interior.PatternColor
Else
ChartObj.SeriesCollection(SIndex).Format.Fill.Fore Color.RGB =
Target.Interior.PatternColor
ChartObj.SeriesCollection(SIndex).Format.Fill.Back Color.RGB =
Target.Interior.Color
End If
ChartObj.SeriesCollection(SIndex).Format.Fill.Tran sparency = 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

Excel 2007 Chart colorindex?
 

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/sh...d.php?t=157914

Microsoft Office Help

Excel 2007 Chart colorindex?
 

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" wrote in message
...

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/sh...d.php?t=157914

Microsoft Office Help