|
-
Oct 30th, 2006, 06:48 AM
#1
Thread Starter
Hyperactive Member
 [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. 
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
-
Oct 30th, 2006, 04:36 PM
#2
Re: Sharing the horror of my Excel report export code
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.
-
Oct 30th, 2006, 05:09 PM
#3
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
 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!
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.
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. 
When working with Excel you should avoid the use of Active Anything 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.
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.
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! 
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.
This is actually fun...I'm learning a ton.
-
Oct 30th, 2006, 05:37 PM
#4
Re: Sharing the horror of my Excel report export code
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.
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.
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!
 That sounds painful!
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.
Feel free, I'll tear them apart too!
This is actually fun...I'm learning a ton.
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.
-
Oct 31st, 2006, 03:43 AM
#5
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
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
-
Oct 31st, 2006, 09:21 AM
#6
Thread Starter
Hyperactive Member
It's broken!
I broke my code! 
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.
-
Oct 31st, 2006, 12:10 PM
#7
Re: Sharing the horror of my Excel report export code
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!
-
Oct 31st, 2006, 03:34 PM
#8
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
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!
-
Oct 31st, 2006, 03:55 PM
#9
Re: Sharing the horror of my Excel report export code
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.
-
Nov 1st, 2006, 04:19 AM
#10
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
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.
-
Nov 1st, 2006, 05:12 AM
#11
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
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
-
Nov 1st, 2006, 10:42 AM
#12
Re: Sharing the horror of my Excel report export code
That all looks ok to me.
Am I right in assuming that the problem is fixed now?
-
Nov 1st, 2006, 11:05 AM
#13
Thread Starter
Hyperactive Member
Re: Sharing the horror of my Excel report export code
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!
I'd rep you but the system won't let me. 
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|
Reply With Quote
