View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
sphenisc sphenisc is offline
external usenet poster
 
Posts: 2
Default changing colours on stacked bar chart

Hi I'm using the following code to change the colours etc.
of a stacked bar chart.

The formats appear to change okay when the macro is run,
but when I select Format Data Series afterwards, the
dialogue box shows the original formatting - can I prevent
this from happening?

Thanks

' Macro1 Macro
' Macro recorded 03/06/2004 by cotae

'Macro notes
' User must select the chart before running the macro
' Each series in the chart is taken successively
' and each 'point' (i.e. rectangular area = section of the
bar) is selected
' the colour of the interior is set, depending on the 'U'
or 'non-U'
' status of the appropriate cell on the active sheet
Application.ScreenUpdating = False

For Each Series In ActiveChart.SeriesCollection
For x = 1 To Series.Points.Count
Series.Points(x).Select
Selection.Interior.Pattern = xlSolid
If ActiveSheet.Cells(3 + Right(Series.Name, Len
(Series.Name) - 6), x).Value = "U" Then
Selection.Interior.ColorIndex = 41 ' blue
Selection.Interior.Pattern = xlSolid
Selection.Border.LineStyle = xlDot 'xlNone
Selection.Border.Weight = xlHairline
Selection.Border.ColorIndex =
ActiveSheet.Cells(3 + Right(Series.Name, Len(Series.Name) -
6), 21).Value + 4
ElseIf ActiveSheet.Cells(3 + Right
(Series.Name, Len(Series.Name) - 6), x).Value = "I1" Then
Selection.Interior.ColorIndex =
39 'purple
Selection.Interior.Pattern = xlSolid
Selection.Border.LineStyle =
xlDot 'xlNone
Selection.Border.Weight = xlHairline
Selection.Border.ColorIndex =
ActiveSheet.Cells(3 + Right(Series.Name, Len(Series.Name) -
6), 21).Value + 4
Else
Selection.Interior.ColorIndex =
xlNone 'no fill
' Selection.Interior.Pattern = xlSolid
Selection.Border.LineStyle =
xlNone 'xlNone
' Selection.Border.ColorIndex =
ActiveSheet.Cells(3 + Right(Series.Name, Len(Series.Name) -
6), 21).Value
End If
Next
If Right(Series.Name, 1) = "0" Then
Application.ScreenUpdating = True
Application.StatusBar = Series.Name
Application.ScreenUpdating = False
End If

Next
Application.ScreenUpdating = True
End Sub