Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 152
Default Help Improving VBA to update Chart Formats

Hi,
I have the following routine that goes through each chart object on a
Dashboard Report Page and updates various formatting options based on what
data I have showing in the chart.

I cobbled some recorded macros with the know-how I have but have a feeling
there's a better mouse-trap.

I read in a table with color values: chtList (Array)
Then go through each chartand:
change the Background Color
Add Data Labels (seperate routine pasted below which is called by main
routine).
Reformat how many decimals the show based on a field from the chart data.

The routine is very slow and I'm not sure if it's because I do a lot of
selecting, then modify the selection or what.
I've also noticed that the first time I run it after opening excel, it's
relatively fast (About 1.5sec per chart). After I re-run the same macro, it
gets progressively slower each time.

Thanks,
Mike Zz

Sub UpdateChartFormat()
'This macro udpates the series and categories for each chart.

Dim oChart As ChartObject
Dim oSeries As SeriesCollection
Dim s
Dim cht As Object, sh As Worksheet

Const MaxCharts = 8
Const MaxChartProperities = 10
Const FColorCol = 2
Const BColorCol = 3

Dim chtList(1 To MaxCharts, 1 To MaxChartProperities)

For i = 1 To MaxCharts
'Read Chart Name and Colors for that chart
chtList(i, 1) = Range("ChartNameA").Offset(i - 1, -2)
chtList(i, FColorCol) = Range("FirstFColor").Offset(i - 1, 0)
chtList(i, BColorCol) = Range("FirstBColor").Offset(i - 1, 0)
Next i

'Application.ScreenUpdating = False
ActiveSheet.Unprotect

For Each oChart In ActiveSheet.ChartObjects
chtName = oChart.Name
'chtSheet is the Data Sheet Name and also the Chart Name without the
"Chart" text.
chtSheet = Replace(chtName, "Chart", "")
For t = 1 To MaxCharts
If chtList(t, 1) = chtSheet Then
CIndex = t
End If
Next t
fcolor = chtList(CIndex, FColorCol)
BColor = chtList(CIndex, BColorCol)

ymax = Sheets(chtSheet).Range("N2").Value

If Application.WorksheetFunction.IsNumber(ymax) = False Then GoTo
NextChart

Select Case ymax
Case Is 1000
labelDec = 0
Case Is 100
labelDec = 1
Case Is 10
labelDec = 1
Case Else
labelDec = 2
End Select

ActiveSheet.ChartObjects(chtName).Activate

s = ActiveChart.SeriesCollection.Count
ActiveChart.ChartArea.Select
Application.CutCopyMode = False
Call OldV2_Add_Val_Lables_To_Series(s, 6, 0, labelDec)

If Application.WorksheetFunction.IsNumber(yDigits) = True Then
'Set Ydigits
Select Case yDigits
Case 0
yFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
Case 1
yFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""?_);_(@_)"
End Select
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = yFormat

'Set Colors
If IsError(fcolor) Then fcolor = 2
If Selection.Fill.ForeColor.SchemeColor = fcolor Then GoTo NextChart
Selection.Fill.Solid
With Selection.Fill
.Solid
.ForeColor.SchemeColor = fcolor
End With

End If
NextChart:
Next

Application.ScreenUpdating = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub


Sub OldV2_Add_Val_Lables_To_Series(seriesX, fsize, forient, lblDec)
'
' Macro6 Macro
' Macro recorded 5/30/2007 by Autoliv North America
'
Dim NumFormat

ActiveChart.SeriesCollection(seriesX).ApplyDataLab els AutoText:=True,
ShowValue:=True
With ActiveChart.SeriesCollection(seriesX).DataLabels.F ont
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = fsize
End With
Select Case lblDec
Case 0
NumFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""_);_(@_)"
Case 1
NumFormat = "_(* #,##0.0_);_(* (#,##0.0);_(* ""-""?_);_(@_)"
Case Else
NumFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
End Select
With ActiveChart.SeriesCollection(seriesX).DataLabels
.Orientation = forient
.NumberFormat = NumFormat
End With


End Sub
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
chart from pivot data does not update x-axis bar chart values - bug jason gers Excel Discussion (Misc queries) 0 April 3rd 07 06:34 PM
Improving use of Worksheets TKeune Excel Worksheet Functions 2 February 11th 06 10:59 AM
copying excel chart formats from one chart to another [email protected] Excel Discussion (Misc queries) 0 August 31st 05 02:18 PM
Using VBA to update Chart Sheet formats and axis titles [email protected] Excel Programming 3 January 15th 04 05:34 PM
need help in improving this macro mcm Excel Programming 0 August 28th 03 04:32 AM


All times are GMT +1. The time now is 12:42 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"