March 8, 2010 at 10:50 am
I currently provide a number of Access reports to customers. I need to duplicate some of these reporting efforts in Excel so my customers can manipulate the data presented. And I could really use some help.
I don't entirely know where to start. I'm good with SQL, and okay with VBA. For a basic start, I'd like to be able run one or more stored procedures in Access to provide a list of detail data and push that data into one spreadsheet (or "tab") within a workbook. Then I'd like to provide other summaries of that exact detail data rolled up to various different summary levels (say, a daily summary, and a summary by product type, or what have you) on other spreadsheets (tabs) in the same workbook. And all this in a reasonable-looking format.
Can anyone point me in the right direction? I've poked around on Google to no avail. Thanks very much.
March 8, 2010 at 5:00 pm
Hi Steve,
If you're going to do it through VBA, then you'll probably want to set a reference to the MS Excel object model to enable you to format the worksheet(s).
I've done a fair bit of this myself, so you might find the following function helpful. It's a cut down version of one of mine that I use quite often, and although I've removed a fair bit of code to keep it simple (mainly relating to totals, borders and logos), it should give you a pretty good idea of what you can do.
This is the function that does all the work (In addition to a reference to MS Excel, you'll also need a reference to ADO):
'====================================================================================
' NAME : CopyToWorksheet
' PURPOSE : Copies data from a from an SQL statement (or query / table) to a
' : worksheet
' RETURNS : Boolean - True if successfully executed, otherwise False.
' ARGUMENTS : aobjWorksheet - The worksheet to copy the data to.
' : astrSQL - The SQL used to return the data to copy from.
' : oalngRowStart - The row to start copying the data to.
' : oalngColumnStart - The column to start copying the data to.
' : oastrTitle - The title to be displayed on the worksheet's tab.
' DEPENDENCIES : {none}
' CREATED : RainbowFfolly 10/10/2008
'====================================================================================
Public Function CopyToWorksheet(aobjWorksheet As Object, _
astrSQL As String, _
Optional oalngRowStart As Long = 1, _
Optional oalngColumnStart As Long = 1, _
Optional oastrTitle As String = vbNullString) As Boolean
'[The function's return value]
Dim booReturnValue As Boolean
'[A recordset based on the SQL used to return the data to copy from]
Dim rst As ADODB.Recordset
'[Used in looping throught the fields in the recordset]
Dim intIndex As Integer
'[The number of records in the recordset]
Dim lngCount As Long
On Error GoTo Error_Handler
'[Initialise the function's return value]
booReturnValue = False
'[Instantiate a new recordset]
Set rst = New ADODB.Recordset
'[Open the data to be copied]
rst.Open astrSQL, CurrentProject.Connection, adOpenKeyset
'[Loop through the fields in the recordset]
For intIndex = 0 To rst.Fields.Count - 1
With aobjWorksheet.Cells(oalngRowStart, oalngColumnStart + intIndex)
'[Add the field name as a column header on the spreadsheet]
.Value = rst.Fields(intIndex).Name
'[Make the column header bold and grey]
.Font.Bold = True
.Interior.ColorIndex = 15
End With
'[Go get the next field]
Next
With aobjWorksheet
'[Copy the data to the spreadsheet]
.Cells(oalngRowStart + 1, oalngColumnStart).CopyFromRecordset rst
'[Resize the columns]
.Rows(oalngRowStart).EntireColumn.AutoFit
'[Set the tab title of the worksheet (if applicable)]
If oastrTitle <> vbNullString Then aobjWorksheet.Name = oastrTitle
End With
'[Close the recordset now we're done with it]
rst.Close
'[Successfully executed so return True]
booReturnValue = True
Exit_Procedure:
'[Release object variable pointer from memory]
Set rst = Nothing
'[Return if successfully executed]
CopyToWorksheet = booReturnValue
Exit Function
Error_Handler:
Select Case Err.Number
Case Else
'[Handle the error]
MsgBox Err.Number & " (CopyToWorksheet)" & vbCrLf & vbCrLf & Err.Description
Resume Exit_Procedure
Resume
End Select
End Function
This is an example of how you would use the above 'CopyToWorksheet' function to write detail data, a daily summary and product type summary to separate sheets in a workbook (I've put dummy query names in there so you can see what lines do what).
'====================================================================================
' NAME : Example
' PURPOSE : An example procedure showing how you would write detail data, a
' : daily summary, and summary by product type queries to separate
' : worksheets in a new MS Excel workbook.
' RETURNS : Boolean - True if successfully executed, otherwise False.
' ARGUMENTS : astrFile - The name of the file to save the MS Excel workbook as.
' DEPENDENCIES : ME - CopyToWorksheet
' CREATED : RainbowFfolly 08/03/2010
'====================================================================================
Public Function Example(astrFile As String) As Boolean
'[The function's return value]
Dim booReturnValue As Boolean
'[Used in creating a new instance of MS Excel]
Dim objExcel As Object
'[The new MS Excel workbook the data will be added to]
Dim objWorkbook As Object
'[The worksheets to copy data to]
Dim objWorksheetDetail As Object
Dim objWorksheetDaily As Object
Dim objWorksheetSummary As Object
On Error GoTo Error_Handler
'[Initialise the function's return value]
booReturnValue = False
'[Create a new instance of MS Excel]
Set objExcel = CreateObject("Excel.Application")
'[Create a new workbook]
Set objWorkbook = objExcel.Workbooks.Add
'[Reference the worksheets to add data to]
Set objWorksheetDetail = objWorkbook.Worksheets(1)
Set objWorksheetDaily = objWorkbook.Worksheets(2)
Set objWorksheetSummary = objWorkbook.Worksheets(3)
'[Write the data to the worksheets]
Call CopyToWorksheet(objWorksheetDetail, "qry_DETAIL", , , "Detail")
Call CopyToWorksheet(objWorksheetDaily, "qry_DAILY_SUMMARY", , , "Daily Summary")
Call CopyToWorksheet(objWorksheetSummary, "qry_PRODUCT_TYPE_SUMMARY", , , _
"Product Summary")
'[Close and save the workbook]
objWorkbook.SaveAs astrFile
'[Exit MS Excel now we're done with it]
objExcel.Quit
'[Successfully executed so return True]
booReturnValue = True
Exit_Procedure:
'[Release object variable pointers from memory]
Set objWorksheetSummary = Nothing
Set objWorksheetDaily = Nothing
Set objWorksheetDetail = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
'[Return if successfully executed]
Example = booReturnValue
Exit Function
Error_Handler:
Select Case Err.Number
Case Else
'[Handle the error]
MsgBox Err.Number & " (Example)" & vbCrLf & vbCrLf & Err.Description
Resume Exit_Procedure
Resume
End Select
End Function
If you want to test how the 'CopyToWorksheet' function works with a single SQL statement, call this procedure and pass the relevant arguments:
'====================================================================================
' NAME : Test
' PURPOSE : Use this procedure to test how the 'CopyToWorksheet' function
' : works.
' RETURNS : Boolean - True if successfully executed, otherwise False.
' ARGUMENTS : astrSQL - The SQL statement (or query / table) to return the data
' : to write to the worksheet.
' : oastrTitle - The title to be displayed on the worksheet's tab.
' : astrFile - The name of the file to save the MS Excel workbook as.
' DEPENDENCIES : ME - CopyToWorksheet
' CREATED : RainbowFfolly 08/03/2010
'====================================================================================
Public Function Test(astrSQL As String, _
astrTitle As String, _
astrFile As String) As Boolean
'[The function's return value]
Dim booReturnValue As Boolean
'[Used in creating a new instance of MS Excel]
Dim objExcel As Object
'[The new MS Excel workbook the data will be added to]
Dim objWorkbook As Object
'[The new worksheet to copy data to]
Dim objWorksheet As Object
On Error GoTo Error_Handler
'[Initialise the function's return value]
booReturnValue = False
'[Create a new instance of MS Excel]
Set objExcel = CreateObject("Excel.Application")
'[Create a new workbook]
Set objWorkbook = objExcel.Workbooks.Add
'[Reference the first worksheet to add data to]
Set objWorksheet = objWorkbook.Worksheets(1)
'[Write the passed query to the worksheet]
Call CopyToWorksheet(objWorksheet, astrSQL, , , astrTitle)
'[Close and save the workbook]
objWorkbook.SaveAs astrFile
'[Exit MS Excel now we're done with it]
objExcel.Quit
'[Successfully executed so return True]
booReturnValue = True
Exit_Procedure:
'[Release object variable pointers from memory]
Set objWorksheet = Nothing
Set objWorkbook = Nothing
Set objExcel = Nothing
'[Return if successfully executed]
Test = booReturnValue
Exit Function
Error_Handler:
Select Case Err.Number
Case Else
'[Handle the error]
MsgBox Err.Number & " (Test)" & vbCrLf & vbCrLf & Err.Description
Resume Exit_Procedure
Resume
End Select
End Function
I've attached the code as a text file, so you should be able to copy it straight into a new VBA module in MS Access.
Hope this helps and good luck!
Cheers,
RF
p.s. Tonight I've been trying to read the "Set Theory and Predicate Logic" chapter from "Inside Microsoft SQL Server 2008 T-SQL Querying", and this has been a very welcome diversion! 😀
_____________________________________________________________
MAXIM 106:
"To know things well, we must know the details; and as they are almost infinite, our knowledge is always superficial and imperfect."
Francois De La Rochefoucauld (1613-1680)
Viewing 2 posts - 1 through 1 (of 1 total)
You must be logged in to reply to this topic. Login to reply