Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
chart from pivot data does not update x-axis bar chart values - bug | Excel Discussion (Misc queries) | |||
Improving use of Worksheets | Excel Worksheet Functions | |||
copying excel chart formats from one chart to another | Excel Discussion (Misc queries) | |||
Using VBA to update Chart Sheet formats and axis titles | Excel Programming | |||
need help in improving this macro | Excel Programming |