R
René
Hello,
I wrote some code, that creates multiple charts (more than 10 or even 20).
The code works fine, but after a short while, it stops for no apparent
reason, while VBE indicates that the code is still running. If I want to stop
it, Excel quits.
I wonder what is causing this. Does someone have the answer? I has probably
to do with the loop, I guess.
See below for the code.
greetings
René
Sub CreateDiskChart()
Dim Bereik
Dim strSheetName As String, strSheetName2 As String, strChartTitle As
String, strWorkBook As String
Dim intRow As Integer, intCharts As Integer
strSheetName = ActiveSheet.Name
Sheets.Add
strSheetName2 = ActiveSheet.Name
strWorkBook = ActiveWorkbook.Name
intCharts =
Application.WorksheetFunction.CountIf(Sheets(strSheetName).Range("A:A"),
"customer")
Sheets(strSheetName).Select
Cells(1).Select
For n = 1 To intCharts
intRow = ActiveCell.Row
Set Bereik = Range(Cells(intRow, 4), Cells(Cells(intRow,
1).CurrentRegion.Rows.Count + intRow - 1, 7))
Range(Cells(intRow, 4), Cells(Cells(intRow,
1).CurrentRegion.Rows.Count + intRow - 1, 7)).Select
strChartTitle = ActiveCell.Item(2, 0).Value & " (" &
MonthName(ActiveCell.Item(2, -1).Value, False) & ")"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Bereik, PlotBy:= _
xlColumns
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
ActiveChart.Location WHERE:=xlLocationAsObject, Name:=strSheetName2
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = strChartTitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Disk"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text =
"Percentage used"
.SeriesCollection(3).Select
.ChartGroups(1).SeriesCollection(3).PlotOrder = 1
End With
z = ActiveSheet.ChartObjects.Count
ActiveSheet.Shapes(z).IncrementLeft 50 + 10 * n
ActiveSheet.Shapes(z).IncrementTop 50 + 10 * n
Workbooks(strWorkBook).Activate
Sheets(strSheetName).Select
ActiveCell.End(xlDown).Select
ActiveCell.End(xlDown).Select
Sheets(strSheetName).Select
Next n
Range("A1").Select
End Sub
I wrote some code, that creates multiple charts (more than 10 or even 20).
The code works fine, but after a short while, it stops for no apparent
reason, while VBE indicates that the code is still running. If I want to stop
it, Excel quits.
I wonder what is causing this. Does someone have the answer? I has probably
to do with the loop, I guess.
See below for the code.
greetings
René
Sub CreateDiskChart()
Dim Bereik
Dim strSheetName As String, strSheetName2 As String, strChartTitle As
String, strWorkBook As String
Dim intRow As Integer, intCharts As Integer
strSheetName = ActiveSheet.Name
Sheets.Add
strSheetName2 = ActiveSheet.Name
strWorkBook = ActiveWorkbook.Name
intCharts =
Application.WorksheetFunction.CountIf(Sheets(strSheetName).Range("A:A"),
"customer")
Sheets(strSheetName).Select
Cells(1).Select
For n = 1 To intCharts
intRow = ActiveCell.Row
Set Bereik = Range(Cells(intRow, 4), Cells(Cells(intRow,
1).CurrentRegion.Rows.Count + intRow - 1, 7))
Range(Cells(intRow, 4), Cells(Cells(intRow,
1).CurrentRegion.Rows.Count + intRow - 1, 7)).Select
strChartTitle = ActiveCell.Item(2, 0).Value & " (" &
MonthName(ActiveCell.Item(2, -1).Value, False) & ")"
Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Bereik, PlotBy:= _
xlColumns
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
ActiveChart.Location WHERE:=xlLocationAsObject, Name:=strSheetName2
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = strChartTitle
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Disk"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text =
"Percentage used"
.SeriesCollection(3).Select
.ChartGroups(1).SeriesCollection(3).PlotOrder = 1
End With
z = ActiveSheet.ChartObjects.Count
ActiveSheet.Shapes(z).IncrementLeft 50 + 10 * n
ActiveSheet.Shapes(z).IncrementTop 50 + 10 * n
Workbooks(strWorkBook).Activate
Sheets(strSheetName).Select
ActiveCell.End(xlDown).Select
ActiveCell.End(xlDown).Select
Sheets(strSheetName).Select
Next n
Range("A1").Select
End Sub