Ms Access and Ms Excel VBA - Dynamic Charts

Hello everybody,

I have a strange problem. I must generate mutliple charts dynamically from a Ms Access database. The solution we wanted to implement is that we export all the Data in Excel, and from then we generate the charts. It's working fine when the charts are define statically. But when it's time to do it dynamically, it doesn't work.

I'll give you an example :

Set xlChartObj(4) = xls.Charts.Add
 
   cTypeChart = "Pie Chart"
   
   
   With xlChartObj(4)
      .ChartType = xlPieExploded
      
      .SeriesCollection.NewSeries
      .SeriesCollection(1).Name = "='Sheet1'!$A$4"
      .SeriesCollection(1).Values = "='Sheet1'!$H$4:$J$4"
      .SeriesCollection(1).XValues = "='Sheet1'!$H$3:$J$3"
      
      .ApplyLayout (6)
      
      .ChartTitle.Text = "Chart Example"
  End With

That code is working well. But, when I'm adapting my solution in a function like :

Private Sub ChartGenerator(ByRef xls As Application.Excel, ByRef xlChartObj As Excel.Chart, ByVal typeChart As Variant, ByVal titleChart As String, ByVal axisX As String, ByVal axisY As String, ByVal layout As Integer, collectionName, collectionX, collectionXVal)

   Dim x As Integer

   With xlChartObj
      
      .ChartType = typeChart
      
      .ClearToMatchStyle
      
      
      For x = 0 To (UBound(collectionName) - 1)
         
         MsgBox "collectionName : " & collectionName(x) & " collectionX : " & collectionX(x) & " collectionXVal : " & collectionXVal(x)
         
         .SeriesCollection(x).Name = collectionName(x)
         .SeriesCollection(x).XValues = collectionX(x)
         
          If x = 0 Then
            .SeriesCollection(1).XValues = collectionXVal(x)
         End If
         
         .SeriesCollection.NewSeries
         
      Next x
      
      .ApplyLayout (layout)
      
      .ChartTitle.Text = titleChart
      
      
      'Assignation du nom de l'axe des X
      .Axes(xlCategory, xlPrimary).AxisTitle.Text = _
        axeX
      
      'Assignation du nom de l'axe des Y
      .Axes(xlValue, xlPrimary).AxisTitle.Text = _
        axeY
   End With

End Sub

and the following code who calls the Procedure

Set xlChartObj(0) = xls.Charts.Add
   
   
 
   cTypeChart = "Line Chart"
   
   ReDim collectionName(3) As Variant
   ReDim collectionX(3) As Variant
   ReDim collectionXVal(3) As Variant
   
   collectionName(0) = "='Sheet1'!$B$3"
   collectionX(0) = "='Sheet1'!$B$4:$B$24"
   collectionXVal(0) = "='Sheet1'!$A$4:$A$24"
   
   collectionName(1) = "='Sheet1'!$C$3"
   collectionX(1) = "='Sheet1'!$C$4:$C$24"
   collectionXVal(1) = ""
   
   collectionName(2) = "='Sheet1'!$D$3"
   collectionX(2) = "='Sheet1'!$D$4:$D$24"
   collectionXVal(2) = ""
   
   ChartGenerator xls, xlChartObj(0), xlLine, "Example", "$", "Values", 1, collectionName, collectionX, collectionXVal

The problems is that I don't see the series at all in the chart and there is no error message. It's like it sees nothing. Do you have any idea, because it's working well with the static code ?

Thank you for your help !

Daniel

Daniel

Where do you have the second code?

If it's in Access then Excel constants like xlLine won't be recognised unless you have a reference to the appropriate Excel library.

PS Where's the rest of the code? For example the part that opens Excel.

Hi Norie,

I'm working with confidential data, so I can't send you the whole project, but I'll give you the most information possible.

Private Sub GoExcel()
   On Error Resume Next
    Dim xls As Excel.Application

    'Variables for the sheets
    ReDim xlSheets(4) As Excel.Worksheets
    Dim xlSheet As Excel.Worksheet


    Set xls = GetObject(, "Excel.Application")

    If Err.Number <> 0 Then
       Err.Clear
       Set xls = CreateObject("Excel.Application")
       xls.Workbooks.Add
    End If


    xls.Windows(xls.ActiveWorkbook.Name).Activate

    xls.Visible = True
    'If xls.Application.WindowState = xlMinimized Then xls.Application.WindowState = xlMaximized
    If xls.Application.WindowState = -4140 Then xls.Application.WindowState = -4137
    xls.Application.ScreenUpdating = True



    'Creating page 1 data
    Set xlFeuil(0) = xls.Sheets.Add(After:=xls.Sheets(xls.Sheets.Count))
    xls.Sheets(xls.Sheets.Count).Name = "Page1"
    xls.Columns("E:J").Select
    xls.Selection.ColumnWidth = 9

    'Import the data in Excel
     ShowExcel xls, xlSheets(0), 0

     'Creating page 2 data
     Set xlSheets(1) = xls.Sheets.Add(After:=xls.Sheets(xls.Sheets.Count))
     xls.Sheets(xls.Sheets.Count).Name = "Page2"
     xls.Columns("E:J").Select
     xls.Selection.ColumnWidth = 9
     ShowExcel xls, xlSheets(1), 1

     'Création des données calculées
     Set xlSheets(2) = xls.Sheets.Add(After:=xls.Sheets(xls.Sheets.Count))
     xls.Sheets(xls.Sheets.Count).Name = "Page3"
     xls.Columns("E:J").Select
     xls.Selection.ColumnWidth = 9
     ComputeExcel xls, xlSheets(2)

     'Creating the chart page
     Set xlSheets(3) = xls.Sheets.Add(After:=xls.Sheets(xls.Sheets.Count))
     xls.Sheets(xls.Sheets.Count).Name = "Page4"
     xls.Columns("E:J").Select
     xls.Selection.ColumnWidth = 9

   Dim cTypeChart As String
    
   ReDim xlChartObj(6) As Excel.Chart
   
   
   On Error GoTo Err_CreateChart
   
   'TD1
   Set xlChartObj(0) = xls.Charts.Add
   
   
 
   cTypeChart = "Line Chart"
   
   ReDim collectionName(3) As String
   ReDim collectionX(3) As String
   ReDim collectionXVal(3) As String
   
   collectionName(0) = "$B$3"
   collectionX(0) = "$B$4:$B$24"
   collectionXVal(0) = "$A$4:$A$24"
   
   collectionName(1) = "$C$3"
   collectionX(1) = "$C$4:$C$24"
   collectionXVal(1) = ""
   
   collectionName(2) = "$D$3"
   collectionX(2) = "$D$4:$D$24"
   collectionXVal(2) = ""
   
   'With xlChartObj(0)
   '   .ChartType = xlLineMarkers
      
      
        '.SeriesCollection(1).Name = "='Page1'!$B$3"
        '.SeriesCollection(1).Values = "='Page1'!$B$4:$B$24"
        '.SeriesCollection(1).XValues = "='Page1'!$A$4:$A$24"
        '  .SeriesCollection.NewSeries
      
        '  .SeriesCollection(2).Name = "='Page1'!$C$3"
        '  .SeriesCollection(2).Values = "='Page1'!$C$4:$C$24"
        '  .SeriesCollection.NewSeries
      
        '  .SeriesCollection(3).Name = "='Page1'!$D$3"
        '  .SeriesCollection(3).Values = "='Page1'!$D$4:$D$24"
      
         '  .ApplyLayout (1)
      
         '  .ChartTitle.Text = "Example"
      
         '  .Axes(xlValue).AxisTitle.Select
      
         'Assignation du nom de l'axe des Y
         '  .Axes(xlValue, xlPrimary).AxisTitle.Text = _
        "X"
      'End With
   
   ChartGenerator xls.Sheets("Page1"), xlChartObj(0), xlLine, "Title", "$", "X", 1, collectionName, collectionX, collectionXVal
   

   
   Dim ws1 As Excel.Worksheet
   Set ws1 = xls.Worksheets("Page4")
   Set xlChartObj(0) = xlChartObj(0).location(xlLocationAsObject, ws1.Name)
   
   With ws1.Shapes("Graphique 1")
      .Left = Range("A2").Left
      .Top = Range("A2").Top
   End With
   
   
   
   Set xlChartObj(0) = Nothing
   Set xlChartObj(1) = Nothing
   Set xlChartObj(2) = Nothing
   Set xlChartObj(3) = Nothing
   Set xlChartObj(4) = Nothing
   Set xlChartObj(5) = Nothing
   
   Set xlSheets(0) = Nothing
   Set xlSheets(1) = Nothing
   Set xlSheets(2) = Nothing
   Set xlSheets(3) = Nothing
   
   Set xls = Nothing
   
   Exit Sub
   
Exit_CreateChart:
   Set xlChartObj(0) = Nothing
   Set xlChartObj(1) = Nothing
   Set xlChartObj(2) = Nothing
   Set xlChartObj(3) = Nothing
   Set xlChartObj(4) = Nothing
   Set xlChartObj(5) = Nothing
   
   Set xlSheets(0) = Nothing
   Set xlSheets(1) = Nothing
   Set xlSheets(2) = Nothing
   Set xlSheets(3) = Nothing
   
   Set xls = Nothing
   
   Exit Sub

Err_CreateChart:

   MsgBox cTypeChart & " " & CStr(Err) & " " & Err.Description & " " & Err.Source
   
   Resume Exit_CreateChart


End Sub

Edited the code for all the 5 other static charts but they are all working well.

Private Sub ChartGenerator(ByRef xlFeuil As Excel.Worksheet, ByRef xlChartObj As Excel.Chart, ByVal typeChart As Variant, ByVal titreChart As String, ByVal axeX As String, ByVal axeY As String, ByVal layout As Integer, collectionName, collectionX, collectionXVal)

   Dim x As Integer
   Dim parametre As String   

   On Error GoTo ErrorGraph

   With xlChartObj
      
      
      .ChartType = typeChart
      
      .ClearToMatchStyle
      
      For x = 0 To (UBound(collectionName) - 1)
         
         
         'Assignation des données de la collection
         parametre = collectionName(x)
         .SeriesCollection(x).Name = "='" & xlFeuil.Name & "'!" & parametre
         
         parametre = collectionX(x)
         position = " collectionX : " & parametre
         .SeriesCollection(x).XValues = "='" & xlFeuil.Name & "'!" & parametre
         
         If x = 0 Then
           parametre = collectionXVal(x)
           .SeriesCollection(1).XValues = "='" & xlFeuil.Name & "'!" & parametre
         End If
         
         .SeriesCollection.NewSeries
         
      Next x
      
      .ApplyLayout (layout)
      
      .ChartTitle.Text = titreChart
      
      
      .Axes(xlCategory, xlPrimary).AxisTitle.Text = _
        axeX
      
      .Axes(xlValue, xlPrimary).AxisTitle.Text = _
        axeY
   End With
   
   Exit Sub
   
ErreurGraph:
   
   MsgBox  CStr(Err) & " " & Err.Description & " " & Err.Source
   
   

End Sub

Have you stepped through the code to see what's happening?

Also, do you have a reference to the Excel object library?

Dagagnon,

Welcome to the forum.

I have added code tags to your 1st post. As per forum rule 3, you need to use them whenever you put any code in your post. Please add them in future. If you need more information on how to use them, check my signature below this post.

I've just noticed something - you are adding the new series after everything else here.

 
      For x = 0 To (UBound(collectionName) - 1)
         
         
         'Assignation des données de la collection
         parametre = collectionName(x)
         .SeriesCollection(x).Name = "='" & xlFeuil.Name & "'!" & parametre
         
         parametre = collectionX(x)
         position = " collectionX : " & parametre
         .SeriesCollection(x).XValues = "='" & xlFeuil.Name & "'!" & parametre
         
         If x = 0 Then
           parametre = collectionXVal(x)
           .SeriesCollection(1).XValues = "='" & xlFeuil.Name & "'!" & parametre
         End If
         
         .SeriesCollection.NewSeries
         
      Next x

Yeah, I know, but the Charts.Add method create a new Collection by default. But the code fails even before that. It gives me a 1004 - Invalid paramter S

Does the code work if you don't use a separate sub?

which line gives the error?

what is the actual (not assumed!) value of parametre at that point and what is in the cell to which it refers?

and what is in the cell?

in your earlier code you had

ByRef xls As Application.Excel

which should be Excel.Application