[RESOLVED] Sharing the horror of my Excel report export code

This code accepts a sql string as a parameter and it downloads the necessary data, throws it into an Excel sheet, then draws three graphs based on the data it has just downloaded. The requirement is for the report to look just like its old Access counterpart, hence a lot of hard-coding has to take place.

Any way to improve this = much appreciated. I'm ready for the absolute worst of criticisms. :D

Thank you.

VB Code:

Public Sub CreateExcelWS(strSQL As String)
 
    Call LoadCaption(True)
 
    ' Checks connection to SQL Server; there should be a connection already
    ' but if there isn't it creates one; if the connection is closed (should
    ' not be) then it opens it.
    Call CheckConnection
    
    Dim objRSArray() As ADODB.Recordset
    Dim objRS As ADODB.Recordset
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim xlChartArray(3) As Object
    Dim i As Integer
    Dim strSource(3) As String
    Dim strParameter As String
    Dim strSproc() As String
    Dim StartPosition(3) As Integer
    
    ' Checks to see if there is already an instance of Excel; if there is
    ' then the current one is used, if not then a new one is created.
    If IsExcelInstalled = True And IsExcelRunning = False Then
        Set xlApp = CreateObject("Excel.Application")
    Else
        Set xlApp = GetObject(, "Excel.Application")
    End If
    
    ' Instantiates Excel objects
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.ActiveSheet
    xlSheet.Name = "Sheet 1"
    
    ' Calls UnpackString() function and assigns the output to the strSproc array
    strSproc = UnpackString("SELECT SQLObject FROM tblReports WHERE ReportName = 'Weekly Summary'")
        
    ' Calls the DeriveWhereClause function and assigns the output to strParameter
    strParameter = DeriveWhereClause
    
    ' Sets up the strSource array using the strSproc array
    For i = 0 To UBound(strSproc)
        strSource(i) = "EXEC " & strSproc(i) & " @Filter = " & "'" & strParameter & "'"
    Next i
   
    ReDim objRSArray(UBound(strSproc))
    ' Instantiates and opens the members of the recordset array and
    ' sets the cursorlocation property so that we can use the
    ' recordcount property later on.
    For i = 0 To UBound(strSproc)
        Set objRSArray(i) = New ADODB.Recordset
        objRSArray(i).CursorLocation = adUseClient
        objRSArray(i).Open strSource(i), cnConn, adOpenForwardOnly, adLockReadOnly, adCmdText
    Next i
    
    
    ' Initializes StartPosition(1) and moves data to Excel; starting position
    ' is determined by sizes of recordsets
    ' First chart
    StartPosition(1) = 4
    Call MoveDataExcel(objRSArray(0), xlSheet, StartPosition(1))
    ' Second chart
    StartPosition(2) = StartPosition(1) + 2 + objRSArray(0).RecordCount
    Call MoveDataExcel(objRSArray(1), xlSheet, StartPosition(2))
    ' Third chart
    StartPosition(3) = StartPosition(2) + 2 + objRSArray(1).RecordCount
    Call MoveDataExcel(objRSArray(2), xlSheet, StartPosition(3))
    
    ' Instantiates chart objects and adds them to the Excel spreadsheet
    For i = 1 To 3
        Set xlChartArray(i) = xlApp.Charts.Add
        Call CreateXLChart(xlSheet, xlChartArray(i), StartPosition(i), xlColumnStacked, "Sheet 1")
    Next i
    
    ' Moves the charts to an appropriate position and sizes them
    Call MoveXLCharts(xlSheet, 1, 30, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 2, 340, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 3, 650, 1, 500, 300)
    
    ' Custom format the first chart
    With xlSheet.ChartObjects(1).Chart
        .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
        .PlotArea.ClearFormats
        .HasTitle = True
        .HasLegend = False
        .ChartTitle.Characters.Text = "Applications Received"
        .ChartTitle.Font.Size = 8
        .Axes(xlValue).TickLabels.Font.Size = 9
        .HasDataTable = True
        With .DataTable
            .ShowLegendKey = True
            .Font.Size = 9
        End With
        ' Changes 'Other Protection' series color to red
        .SeriesCollection(4).Interior.ColorIndex = 6
        ' Changes 'Term' series color to light green
        .SeriesCollection(3).Interior.ColorIndex = 24
        ' Changes 'MLI' series color to bluey-purple
        .SeriesCollection(2).Interior.ColorIndex = 22
        ' Changes 'PTA' series color to pale yellow
        .SeriesCollection(5).Interior.ColorIndex = 3
        ' Changes 'Low Touch' series color to white
        .SeriesCollection(6).Interior.ColorIndex = 2
        ' Removes the prop total series from the graph but not
        ' from the data table
        With .SeriesCollection(1)
            .ChartType = xlLine
            .Border.Weight = xlThin
            .Border.LineStyle = xlNone
        End With
    End With
    
    ' Custom format the second chart
    With xlSheet.ChartObjects(2).Chart
        .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
        .PlotArea.ClearFormats
        .HasTitle = True
        .HasLegend = False
        .ChartTitle.Characters.Text = "Cases Accepted - UW Decision Made"
        .ChartTitle.Font.Size = 8
        .Axes(xlValue).TickLabels.Font.Size = 9
        .HasDataTable = True
        .DataTable.ShowLegendKey = True
        .DataTable.Font.Size = 9
    End With
    
    ' Custom format the third chart
    With xlSheet.ChartObjects(3).Chart
        .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
        .PlotArea.ClearFormats
        .HasTitle = True
        .HasLegend = False
        .ChartTitle.Characters.Text = "Applications Issued"
        .ChartTitle.Font.Size = 8
        .Axes(xlValue).TickLabels.Font.Size = 9
        .HasDataTable = True
        With .DataTable
            .ShowLegendKey = True
            .Font.Size = 9
        End With
        .SeriesCollection(3).Interior.ColorIndex = 6
        .SeriesCollection(4).Interior.ColorIndex = 3
        .SeriesCollection(5).Interior.ColorIndex = 2
        .SeriesCollection(6).Interior.ColorIndex = 15
    End With
    
    ' Grab the rundate off the server since we need it for the
    ' report title 'as at' value
    Dim strDate As String
    Set objRS = cnConn.Execute("SELECT RunDate FROM DateRanges")
    strDate = objRS.Fields(0).Value
    
    ' Set up report titles
    Call CreateReportTitles(xlSheet, "A1:E2", xlGeneral, "NB Protection Volumes As At: " & strDate, 12)
    Call CreateReportTitles(xlSheet, "F1:J1", 4, GetgVarPrimInfoValue(), 8)
    Call CreateReportTitles(xlSheet, "F2:J2", 4, AdditionalInfo(GetgVarAddInfoType(), GetgVarAddInfoValue()), 8)
    
    ' Sets up page margins and forces the data all onto one page.
    With xlSheet.PageSetup
        .LeftMargin = 0.4
        .RightMargin = 0.4
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With
    
    ' Cells in the given range will have a white font
    xlSheet.Range("A4:I60").Font.ColorIndex = 2
    
    ' Makes Excel visible
    xlApp.Visible = True
    
    Call LoadCaption(False)
    
    ' Destroy objects
    For i = 0 To UBound(strSproc)
        objRSArray(i).Close
        Set objRSArray(i) = Nothing
    Next i
    Set objRS = Nothing
    Set xlChartArray(0) = Nothing
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
End Sub

UnpackString takes the comma-delimited list of three stored procedures that are the sources for the three graphs and presents them in a way that VB can deal with them:

VB Code:

Public Function UnpackString(strVal As String)
    
    Dim rst As ADODB.Recordset
    Dim strArray() As String
    Dim intMemCount As Integer
    
    Set rst = New ADODB.Recordset
    rst.Open strVal, cnConn, adOpenForwardOnly, adLockReadOnly, adCmdText
    
    strArray = Split(rst.GetString, ",")
    intMemCount = UBound(strArray)
  
    ' CleanString cuts off the unwanted gremlin character at the end
    strArray(intMemCount) = CleanString(strArray(intMemCount))
    UnpackString = strArray
 
    rst.Close
    Set rst = Nothing
    
End Function

MoveDataExcel:

VB Code:

Public Sub MoveDataExcel(rstExport As ADODB.Recordset, xlSheet As Object, intStartLine As Integer)
 
    Dim i As Integer
    For i = 0 To rstExport.Fields.Count - 1
        xlSheet.Cells(intStartLine, i + 1).Value = rstExport.Fields(i).Name
    Next i
    
    xlSheet.Range("A" & intStartLine + 1).CopyFromRecordset rstExport
    
End Sub

MoveXLCharts:

VB Code:

Public Sub MoveXLCharts(xlSheet As Object, chartNum As Integer, _
    Top, Left, Width, Height As Integer)
 
    With xlSheet
        With .ChartObjects(chartNum)
            .Top = Top
            .Left = Left
            .Width = Width
            .Height = Height
        End With
    End With
    
End Sub

I'll go in reverse order again!

In MoveXLCharts, you havent set data types for some of the parameters, and you do not need both 'With' blocks - just one will do it.

VB Code:

Public Sub MoveXLCharts(xlSheet As Object, chartNum As Integer, _
                        Top [b]As Integer[/b], Left [b]As Integer[/b], Width [b]As Integer[/b], Height As Integer)
 
    With xlSheet.ChartObjects(chartNum)
      .Top = Top
...

I think UnpackString and MoveDataExcel are fine.

And now on to CreateExcelWS...

You have declared strSource with a specific number of elements, and fill it based on an array which comes from another function (UnpackString). If the amount of data returned ever increases, you will get an error. I would use a dynamic array instead (as you have for strSproc), and ReDim it to the UBound of the other array.

I notice that you have declared your Excel related variables "as Object", so I presume you are using Late Binding. If this is the case, you need to declare all of the constants you use (such as xlLine and xlThin). If you haven't done this already, I would recommend using the module that is linked from post #13 of my Excel tutorial.

When working with Excel you should avoid the use of ActiveAnything and Selection, as they can cause errors seemingly randomly (depending on what the user is doing at the time). Here is an amended version which will not have any problems:

VB Code:

Set xlSheet = xlBook[b].Sheets(1)[/b]

In the sections "Custom format the ? chart", you repeat a large chunk of identical code for all three - so that could be in a loop, eg:

VB Code:

'Set common formats for the charts
    For i = 1 To 3
      With xlSheet.ChartObjects(i).Chart
          .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
          .PlotArea.ClearFormats
          .HasTitle = True
          .HasLegend = False
          .ChartTitle.Font.Size = 8
          .Axes(xlValue).TickLabels.Font.Size = 9
          .HasDataTable = True
          .DataTable.ShowLegendKey = True
          .DataTable.Font.Size = 9
      End With
    Next i
 
    ' Custom format the first chart
    With xlSheet.ChartObjects(1).Chart
        .ChartTitle.Characters.Text = "Applications Received"
        ' Changes 'Other Protection' series color to red
        .SeriesCollection(4).Interior.ColorIndex = 6
        ' Changes 'Term' series color to light green
        .SeriesCollection(3).Interior.ColorIndex = 24
        ' Changes 'MLI' series color to bluey-purple
        .SeriesCollection(2).Interior.ColorIndex = 22
        ' Changes 'PTA' series color to pale yellow
        .SeriesCollection(5).Interior.ColorIndex = 3
        ' Changes 'Low Touch' series color to white
        .SeriesCollection(6).Interior.ColorIndex = 2
        ' Removes the prop total series from the graph but not
        ' from the data table
        With .SeriesCollection(1)
            .ChartType = xlLine
            .Border.Weight = xlThin
            .Border.LineStyle = xlNone
        End With
    End With
    
    ' Custom format the second chart
    With xlSheet.ChartObjects(2).Chart
        .ChartTitle.Characters.Text = "Cases Accepted - UW Decision Made"
    End With
    
    ' Custom format the third chart
    With xlSheet.ChartObjects(3).Chart
        .ChartTitle.Characters.Text = "Applications Issued"
        .SeriesCollection(3).Interior.ColorIndex = 6
        .SeriesCollection(4).Interior.ColorIndex = 3
        .SeriesCollection(5).Interior.ColorIndex = 2
        .SeriesCollection(6).Interior.ColorIndex = 15
    End With

For opening the recordset near the end, you use cnConn.Execute.. I would prefer to use the objRS.Open method (for consistency at least), but it will work either way. Note that you do not .Close it when you are finished with it - and you need to.


The DeriveWhereClause function is a bit of a "black box", I'm surprised to not see any parameters to it - but I guess that depends on what it does (if it is based on values from controls, it makes sense).

You also haven't shown us CreateXLChart (I hope you are setting the location in it!), or CreateReportTitles.

Quote:

---

Originally Posted by si_the_geek

I'll go in reverse order again!

In MoveXLCharts, you havent set data types for some of the parameters, and you do not need both 'With' blocks - just one will do it.

VB Code:

Public Sub MoveXLCharts(xlSheet As Object, chartNum As Integer, _
                        Top [b]As Integer[/b], Left [b]As Integer[/b], Width [b]As Integer[/b], Height As Integer)
 
    With xlSheet.ChartObjects(chartNum)
      .Top = Top
...

I think UnpackString and MoveDataExcel are fine.

---

Hehehe, dumb me...I thought that if I gave it a list of parameters and just specified the last one as an integer it would assume that they were all integers. Doh!

Quote:

---

And now on to CreateExcelWS...

You have declared strSource with a specific number of elements, and fill it based on an array which comes from another function (UnpackString). If the amount of data returned ever increases, you will get an error. I would use a dynamic array instead (as you have for strSproc), and ReDim it to the UBound of the other array.

---

Good idea.

Quote:

---

I notice that you have declared your Excel related variables "as Object", so I presume you are using Late Binding. If this is the case, you need to declare all of the constants you use (such as xlLine and xlThin). If you haven't done this already, I would recommend using the module that is linked from post #13 of my Excel tutorial.

---

Yep, I'm using late binding as recommended by many on this board. There's an entire module in the project that contains nothing but Excel constants that I downloaded from Microsoft's site. :thumb:

Quote:

---

When working with Excel you should avoid the use of ActiveAnything and Selection, as they can cause errors seemingly randomly (depending on what the user is doing at the time). Here is an amended version which will not have any problems:

VB Code:

Set xlSheet = xlBook[b].Sheets(1)[/b]

---

Yeah, I don't like Active or Selection but I don't know the Excel object model that well. I'll research those and take them out but it might take a while; we've got about a dozen custom Excel subs similar to this one. We have two kinds of reports...reports presented as just a spreadsheet of data and reports with graphs and other chunks of data scattered around. The spreadsheet types are handled by a single sub; all the others have their own custom subs.

Quote:

---

In the sections "Custom format the ? chart", you repeat a large chunk of identical code for all three - so that could be in a loop, eg:

VB Code:

'Set common formats for the charts
    For i = 1 To 3
      With xlSheet.ChartObjects(i).Chart
          .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
          .PlotArea.ClearFormats
          .HasTitle = True
          .HasLegend = False
          .ChartTitle.Font.Size = 8
          .Axes(xlValue).TickLabels.Font.Size = 9
          .HasDataTable = True
          .DataTable.ShowLegendKey = True
          .DataTable.Font.Size = 9
      End With
    Next i
 
    ' Custom format the first chart
    With xlSheet.ChartObjects(1).Chart
        .ChartTitle.Characters.Text = "Applications Received"
        ' Changes 'Other Protection' series color to red
        .SeriesCollection(4).Interior.ColorIndex = 6
        ' Changes 'Term' series color to light green
        .SeriesCollection(3).Interior.ColorIndex = 24
        ' Changes 'MLI' series color to bluey-purple
        .SeriesCollection(2).Interior.ColorIndex = 22
        ' Changes 'PTA' series color to pale yellow
        .SeriesCollection(5).Interior.ColorIndex = 3
        ' Changes 'Low Touch' series color to white
        .SeriesCollection(6).Interior.ColorIndex = 2
        ' Removes the prop total series from the graph but not
        ' from the data table
        With .SeriesCollection(1)
            .ChartType = xlLine
            .Border.Weight = xlThin
            .Border.LineStyle = xlNone
        End With
    End With
    
    ' Custom format the second chart
    With xlSheet.ChartObjects(2).Chart
        .ChartTitle.Characters.Text = "Cases Accepted - UW Decision Made"
    End With
    
    ' Custom format the third chart
    With xlSheet.ChartObjects(3).Chart
        .ChartTitle.Characters.Text = "Applications Issued"
        .SeriesCollection(3).Interior.ColorIndex = 6
        .SeriesCollection(4).Interior.ColorIndex = 3
        .SeriesCollection(5).Interior.ColorIndex = 2
        .SeriesCollection(6).Interior.ColorIndex = 15
    End With

For opening the recordset near the end, you use cnConn.Execute.. I would prefer to use the objRS.Open method (for consistency at least), but it will work either way. Note that you do not .Close it when you are finished with it - and you need to.

---

Cool, thanks.

Quote:

---

The DeriveWhereClause function is a bit of a "black box", I'm surprised to not see any parameters to it - but I guess that depends on what it does (if it is based on values from controls, it makes sense).

---

The DeriveWhereClause() function doesn't use parameters; it gets its information from global variables that grab the selections the users make on the form; it's actually fed by a couple of other functions that build the SQL strings that the program uses. I could post those at another date so you can recoil in horror! :lol:

Quote:

---

You also haven't shown us CreateXLChart (I hope you are setting the location in it!), or CreateReportTitles.

---

I didn't show those cos I didn't think they were overly important but I can post them tomorrow if you like. CreateXLChart does define the report's location. :thumb:

This is actually fun...I'm learning a ton. :thumb:

Quote:

---

Originally Posted by disruptivehair

Hehehe, dumb me...I thought that if I gave it a list of parameters and just specified the last one as an integer it would assume that they were all integers. Doh!

---

That's a common misconception about "Classic" VB - other languages allow you to specify one data type for a group of variables/parameters, but for VB you have to specify each one. If you don't, they are declared as Variant.

Quote:

---

Yeah, I don't like Active or Selection but I don't know the Excel object model that well. I'll research those and take them out but it might take a while;

---

Well there's only the one in this sub, so hopefully it wont take you too long for the others.

Quote:

---

The DeriveWhereClause() function doesn't use parameters; it gets its information from global variables that grab the selections the users make on the form; it's actually fed by a couple of other functions that build the SQL strings that the program uses. I could post those at another date so you can recoil in horror! :lol:

---

:eek2: That sounds painful!

Quote:

---

I didn't show those cos I didn't think they were overly important but I can post them tomorrow if you like. CreateXLChart does define the report's location. :thumb:

---

Feel free, I'll tear them apart too! :lol:

Quote:

---

This is actually fun...I'm learning a ton. :thumb:

---

Good stuff :)

It's nice to have a focus on "how to improve" every now and then, rather than getting things done ASAP, or just learning enough of something to get it working.

Quote:

---

Originally Posted by si_the_geek

You also haven't shown us CreateXLChart (I hope you are setting the location in it!), or CreateReportTitles.

---

CreateXLChart:

VB Code:

Public Sub CreateXLChart(xlSheetF As Object, xlChartF As Object, RowNum As Integer, _
    ChartType As String, ReportName As String)
        
        With xlChartF
            .ChartType = ChartType
            .SetSourceData xlSheetF.Cells(RowNum, 1).CurrentRegion
            .PlotBy = xlColumns
            .Location Where:=xlLocationAsObject, Name:=ReportName
        End With
    
End Sub

CreateReportTitles:

VB Code:

Public Sub CreateReportTitles(xlSheetF As Object, strRange As String, hAlign As Variant, _
    strVal As String, fSize As Integer)
    
    With xlSheetF
        With .Range(strRange)
            .HorizontalAlignment = hAlign
            .VerticalAlignment = xlCenter
            .WrapText = True
            .MergeCells = True
            .Value = strVal
            .Font.Bold = True
            .Font.Size = fSize
        End With
    End With
End Sub

I broke my code! :cry:

VB Code:

Public Sub CreateExcelWSBROKEN(strsql As String)
 
    Call LoadCaption(True)
    Call CheckConnection
    
    Dim objRSArray() As ADODB.Recordset
    Dim objRS As ADODB.Recordset
    
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim xlChartArray() As Object
    
    Dim i As Integer
    Dim strSource() As String
    Dim strParameter As String
    Dim strSproc() As String
    Dim StartPosition() As Integer
    
    ' Checks to see if Excel is installed and if there is already an
    ' instance of it; if there is then the current instance is used,
    ' if not a new one is created.  If Excel is not installed an
    ' error is displayed.
    If IsExcelInstalled = True And IsExcelRunning = False Then
        Set xlApp = CreateObject("Excel.Application")
    Else
        Set xlApp = GetObject(, "Excel.Application")
    End If
    
    ' Instantiates Excel objects
    Set xlBook = xlApp.Workbooks.Add
    'Set xlSheet = xlBook.Sheets(1)
    Set xlSheet = xlBook.ActiveSheet
    'xlSheet.Name = Left$(GetgVarReportSelected(), 30)
    xlSheet.Name = "Sheet 1"
    
    ' Calls UnpackString() function and assigns the output to the strSproc array
    strSproc = UnpackString("SELECT SQLObject FROM tblReports WHERE ReportName = 'Weekly Summary'")
    
    ' Calls the DeriveWhereClause() function and assigns the output to strParameter
    strParameter = DeriveWhereClause()
    
    ReDim strSource(UBound(strSproc))
    
    ' Sets up strSource array using the strSproc array
    For i = 0 To UBound(strSproc)
        strSource(i) = "EXEC " & strSproc(i) & " @Filter = " & "'" & strParameter & "'"
    Next i
    
    ReDim objRSArray(UBound(strSproc))
    
    ' Instantiates and opens the members of the recordset array and sets the
    ' cursorlocation property so that we can use the recordcount property later on.
    For i = 0 To UBound(strSproc)
        Set objRSArray(i) = New ADODB.Recordset
        objRSArray(i).CursorLocation = adUseClient
        objRSArray(i).Open strSource(i), cnConn, adOpenForwardOnly, adLockReadOnly, adCmdText
    Next i
    
    ' Redims and initializes StartPosition() and moves data to Excel; starting position
    ' is determined by sizes of recordsets
    ReDim StartPosition(UBound(objRSArray))
    
    ' First chart
    StartPosition(0) = 4
    Call MoveDataExcel(objRSArray(0), xlSheet, StartPosition(0))
    ' Second chart
    StartPosition(1) = StartPosition(0) + 2 + objRSArray(0).RecordCount
    Call MoveDataExcel(objRSArray(1), xlSheet, StartPosition(1))
    ' Third chart
    StartPosition(2) = StartPosition(1) + 2 + objRSArray(1).RecordCount
    Call MoveDataExcel(objRSArray(2), xlSheet, StartPosition(2))
    
    ReDim xlChartArray(UBound(objRSArray))
    
    ' Redims and initializes xlChartArray() and adds them to the Excel worksheet
'    For i = 0 To UBound(xlChartArray)
'        Set xlChartArray(i) = xlApp.Charts.Add
'        Call CreateXLChart(xlSheet, xlChartArray(i), StartPosition(i), xlColumnStacked, "Sheet 1")
'    Next i
    
    For i = 0 To UBound(xlChartArray)
        Set xlChartArray(i) = xlApp.Charts.Add
    Next i
[COLOR=DarkRed][B]    Call CreateXLChart(xlSheet, xlChartArray(0), StartPosition(0), xlColumnStacked, "WS")[/B][/COLOR]
        xlApp.Visible = True
 
    Exit Sub
    
    ' Moves the charts to an appropriate location and sizes them
    Call MoveXLCharts(xlSheet, 0, 30, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 1, 340, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 2, 650, 1, 500, 300)
    
 
    
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Erase objRSArray
    Erase xlChartArray
    Erase StartPosition
    Erase strSource
    Erase strSproc
    
End Sub

It bombs out on the bolded line and highlights the location line in CreateXLChart:

VB Code:

Public Sub CreateXLChart(xlSheetF As Object, xlChartF As Object, RowNum As Integer, _
    ChartType As String, ReportName As String)
        
        With xlChartF
            .ChartType = ChartType
            .SetSourceData xlSheetF.Cells(RowNum, 1).CurrentRegion
            .PlotBy = xlColumns
            [COLOR=DarkRed][B].Location Where:=xlLocationAsObject, Name:=ReportName[/B][/COLOR]
        End With
    
End Sub

The error is:

'Run-time error '1004':

Application-defined or object-defined error'

The original code I posted works but this code doesn't. I've been pounding my head on the desk for an hour trying different things. First thing I did was check that all the SQL strings are running correctly and returning data, since normally when I see an error 1004 it's because I tried to pass Excel a data set that's too small or empty.

CreateXLChart is fine, and the only thing in CreateReportTitles is that you could use a single With block (like with MoveXLCharts).


The current problem seems to be that you have changed "Sheet 1" to "WS". I presume it would be best to use xlSheet.Name instead of a fixed string (that way any changes to the name in the rest of the code are irrelevant).

I can also see another potential problem - in the calls to MoveXLCharts you have changed the numbering from 1+ to 0+, which may well be an issue as ChartObjects (in MoveXLCharts) is a collection (1 based) rather than an array (0 based). How annoying!

Quote:

---

Originally Posted by si_the_geek

CreateXLChart is fine, and the only thing in CreateReportTitles is that you could use a single With block (like with MoveXLCharts).


The current problem seems to be that you have changed "Sheet 1" to "WS". I presume it would be best to use xlSheet.Name instead of a fixed string (that way any changes to the name in the rest of the code are irrelevant).

I can also see another potential problem - in the calls to MoveXLCharts you have changed the numbering from 1+ to 0+, which may well be an issue as ChartObjects (in MoveXLCharts) is a collection (1 based) rather than an array (0 based). How annoying!

---

The prob is that when I instantiate the chart object it's creating three new charts as brand-new worksheets in the app! Eeeeek!

As both code samples are the same up to that point (apart from the array indexes), the only possible thing I can see is that the name is getting confused somehow.. all I can suggest is to either hard-code it to the same name as at the top of the code, or use the 'dynamic' version I described, eg:

VB Code:

Call CreateXLChart(xlSheet, xlChartArray(0), StartPosition(0), xlColumnStacked, [u]"Sheet 1"[/u])
    Call CreateXLChart(xlSheet, xlChartArray(0), StartPosition(0), xlColumnStacked, [u]xlSheet.Name[/u])  '(no quotes)

..if neither of those work, I'd recommend starting a new thread about it in the Office Development forum - as something is wrong.

Quote:

---

Originally Posted by si_the_geek

As both code samples are the same up to that point (apart from the array indexes), the only possible thing I can see is that the name is getting confused somehow.. all I can suggest is to either hard-code it to the same name as at the top of the code, or use the 'dynamic' version I described, eg:

VB Code:

Call CreateXLChart(xlSheet, xlChartArray(0), StartPosition(0), xlColumnStacked, [u]"Sheet 1"[/u])
    Call CreateXLChart(xlSheet, xlChartArray(0), StartPosition(0), xlColumnStacked, [u]xlSheet.Name[/u])  '(no quotes)

..if neither of those work, I'd recommend starting a new thread about it in the Office Development forum - as something is wrong.

---

Thanks si, I'll try that; I'm sure it's something I'm doing since the old sub still works. :thumb:

OK si, how does this look? :)

VB Code:

Public Sub CreateExcelWS(strSQL As String)
 
    ' Sets loading caption on on the CriteriaSelection form and checks the
    ' connection to the SQL Server
    Call LoadCaption(True)
    Call CheckConnection
    
    ' ADO recordset array and Excel objects
    Dim objRSArray() As ADODB.Recordset
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim xlChartArray() As Object
    
    ' Variables
    Dim i As Integer
    Dim strSource() As String
    Dim strSproc() As String
    Dim StartPosition() As Integer
    Dim strReportName As String
    
    ' Checks to see if Excel is installed and if there is an instance of it;
    ' if there is an instance the sub uses the current one, if there isn't
    ' then the sub creates one.
    If IsExcelInstalled = True And IsExcelRunning = False Then
        Set xlApp = CreateObject("Excel.Application")
    Else
        Set xlApp = GetObject(, "Excel.Application")
    End If
    
    ' Instantiate Excel objects
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Sheets(1)
    strReportName = Left$(GetgVarReportSelected(), 30)
    xlSheet.Name = strReportName
    
    ' Calls UnpackString() function and assigns the output to the strSproc array
    strSproc = UnpackString("SELECT SQLObject FROM tblReports WHERE ReportName = 'Weekly Summary'")
    
    ' Sizes the strSource array to be the same size as strSproc
    ' The strSource array holds the SQL strings that will grab the data from the server
    ReDim strSource(UBound(strSproc))
    For i = 0 To UBound(strSproc)
        strSource(i) = "EXEC " & strSproc(i) & " @Filter = " & "'" & DeriveWhereClause() & "'"
    Next i
    
    ' Sets up the ADO recordsets (same number as there are names of stored procedures) and
    ' uses the members of strSource() to open them
    ReDim objRSArray(UBound(strSproc))
    For i = 0 To UBound(objRSArray)
        Set objRSArray(i) = New ADODB.Recordset
        objRSArray(i).CursorLocation = adUseClient
        objRSArray(i).Open strSource(i), cnConn, adOpenForwardOnly, adLockReadOnly, adCmdText
    Next i
    
    ' StartPosition() starts at row 4 and uses the sizes of the data sets and values of
    ' other members of StartPosition() to determine where to place the data.  The MoveDataExcel()
    ' sub actually places the data onto the Excel spreadsheet.
    ReDim StartPosition(UBound(objRSArray))
    StartPosition(0) = 4
    Call MoveDataExcel(objRSArray(0), xlSheet, StartPosition(0))
    StartPosition(1) = StartPosition(0) + 2 + objRSArray(0).RecordCount
    Call MoveDataExcel(objRSArray(1), xlSheet, StartPosition(1))
    StartPosition(2) = StartPosition(1) + 2 + objRSArray(1).RecordCount
    Call MoveDataExcel(objRSArray(2), xlSheet, StartPosition(2))
    
    For i = 0 To UBound(objRSArray)
        objRSArray(i).Close
    Next i
    
    ' Redimensions xlChartArray() array, instantiates chart objects, and adds them to the
    ' Excel spreadsheet
    ReDim xlChartArray(UBound(objRSArray))
    For i = 0 To UBound(xlChartArray)
        Set xlChartArray(i) = xlApp.Charts.Add
        Call CreateXLChart(xlSheet, xlChartArray(i), StartPosition(i), xlColumnStacked, strReportName)
    Next i
    
    Call MoveXLCharts(xlSheet, 1, 30, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 2, 340, 1, 500, 300)
    Call MoveXLCharts(xlSheet, 3, 650, 1, 500, 300)
    
    ' Each chart is a bit different but this loop performs all the actions that are
    ' done to each chart
    For i = 0 To UBound(xlChartArray)
        With xlSheet.ChartObjects(i + 1).Chart
            .Axes(xlCategory, xlPrimary).CategoryType = xlCategoryScale
            .PlotArea.ClearFormats
            .HasTitle = True
            .HasLegend = False
            .Axes(xlValue).TickLabels.Font.Size = 9
            .HasDataTable = True
            With .DataTable
                .ShowLegendKey = True
                .Font.Size = 9
            End With
        End With
    Next i
    
    With xlSheet
        With .ChartObjects(1).Chart
            .ChartTitle.Characters.Text = "Applications Received"
            .ChartTitle.Font.Size = 8
            .SeriesCollection(4).Interior.ColorIndex = 6
            .SeriesCollection(3).Interior.ColorIndex = 24
            .SeriesCollection(2).Interior.ColorIndex = 22
            .SeriesCollection(5).Interior.ColorIndex = 3
            .SeriesCollection(6).Interior.ColorIndex = 2
            With .SeriesCollection(1)
                .ChartType = xlLine
                .Border.Weight = xlThin
                .Border.LineStyle = xlNone
            End With
        End With
        With .ChartObjects(2).Chart
            .ChartTitle.Characters.Text = "Cases Accepted - UW Decision Made"
            .ChartTitle.Font.Size = 8
        End With
        With .ChartObjects(3).Chart
            .ChartTitle.Characters.Text = "Applications Issued"
            .ChartTitle.Font.Size = 8
            .SeriesCollection(3).Interior.ColorIndex = 6
            .SeriesCollection(4).Interior.ColorIndex = 3
            .SeriesCollection(5).Interior.ColorIndex = 2
            .SeriesCollection(6).Interior.ColorIndex = 15
        End With
    End With
    
    Call CreateReportTitles(xlSheet, "A1:E2", xlGeneral, "NB Protection Volumes As At: " & GetRunDate, 12)
    Call CreateReportTitles(xlSheet, "F1:J1", 4, GetgVarPrimInfoValue(), 8)
    Call CreateReportTitles(xlSheet, "F2:J2", 4, AdditionalInfo(GetgVarAddInfoType(), GetgVarAddInfoValue()), 8)
        
    With xlSheet.PageSetup
        .LeftMargin = 0.4
        .RightMargin = 0.4
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
    End With
        
    xlSheet.Range("A4:I60").Font.ColorIndex = 2
    
        
    ' Sets caption on CriteriaSelection back to blank
    Call LoadCaption(False)
    xlApp.Visible = True
    
    
    ' Destroy objects
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Erase objRSArray
    Erase xlChartArray
        
End Sub

That all looks ok to me. :)

Am I right in assuming that the problem is fixed now?

Quote:

---

Originally Posted by si_the_geek

That all looks ok to me. :)

Am I right in assuming that the problem is fixed now?

---

Yep, it's all working great now! :thumb:

I'd rep you but the system won't let me. :(