Hi all
I have read some posts here and there about problems with looping through every chart in a workbook. Now I have similar problems and I dont seem to get the suggested alternatives to work better than what I all ready have.
The code I all ready have is code which some other insightfull vba guy on the net have written.
Now the problem I am trying to solve is to breake the links between a chart and its scource data. In my workbook I have several sheets with several charts on them. I want to distribute my workbook to others without the scource data, and that's where trouble begins.
An alternative solution could be to make pictures out of the charts before deleting scource data, but the loop problems would still remais.
Here is the code so far. It runs without errors but fail to loop through all charts:
In stead of using For each I have tried for i = 1 to ws.ChartObjects.Count but with no improvement.
I have read some posts here and there about problems with looping through every chart in a workbook. Now I have similar problems and I dont seem to get the suggested alternatives to work better than what I all ready have.
The code I all ready have is code which some other insightfull vba guy on the net have written.
Now the problem I am trying to solve is to breake the links between a chart and its scource data. In my workbook I have several sheets with several charts on them. I want to distribute my workbook to others without the scource data, and that's where trouble begins.
An alternative solution could be to make pictures out of the charts before deleting scource data, but the loop problems would still remais.
Here is the code so far. It runs without errors but fail to loop through all charts:
Code:
Sub break_chart_links()
Dim iCtr As Integer, iChars As Integer, iPlotOrder As Integer
Dim nPts As Long, iPts As Long 'Holds the total no of points in the chart
Dim xArray, yArray, sChtName As String, sSrsName As String
Dim xVals, yVals
Dim ChtSeries As Series ' var used to loop thru the series collection
Dim ws As Worksheet
Dim sChartType As String, iCtr1 As Integer
Dim SH As Shape
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
For Each SH In ws.Shapes
On Error Resume Next
SH.Select
If SH.Type = msoChart Then
sChtName = ActiveChart.Name
For Each ChtSeries In ActiveChart.SeriesCollection
nPts = ChtSeries.Points.Count
xArray = ""
yArray = ""
xVals = ChtSeries.XValues
yVals = ChtSeries.Values
sSrsName = ChtSeries.Name
iPlotOrder = ChtSeries.PlotOrder
For iPts = 1 To nPts
If IsNumeric(xVals(iPts)) Then
' SHORTEN NOS IN X ARRAY (REMOVING EXCESS DIGITS)
iChars = WorksheetFunction.Max(InStr(CStr(xVals(iPts)), "."), 5)
xArray = xArray & Left(CStr(xVals(iPts)), iChars) & ","
Else
'PUTTING QUOTES AROUND STRING VALUES
xArray = xArray & """" & xVals(iPts) & ""","
End If
'SAME AS X (ABOVE)
iChars = WorksheetFunction.Max(InStr(CStr(yVals(iPts)), "."), 5)
''' handle missing data - replace blanks and #N/A with #N/A
If IsEmpty(yVals(iPts)) Or WorksheetFunction.IsNA(yVals(iPts)) Then
yArray = yArray & "#N/A,"
Else
' NEED TO ROUND NUMBERS ELSE THROWS ERROR
yArray = yArray & Round(Left(CStr(yVals(iPts)), iChars), 0) & ","
End If
Next
'REMOVE FINAL COMMA
xArray = Left(xArray, Len(xArray) - 1)
yArray = Left(yArray, Len(yArray) - 1)
With ChtSeries
.Values = yArray
.XValues = xArray
.Name = sSrsName
.PlotOrder = iPlotOrder
End With
Next
End If
Next SH
Next
End SubIn stead of using For each I have tried for i = 1 to ws.ChartObjects.Count but with no improvement.
Last edited:
