< Day Day Up > |

When changing data in an existing Excel report from Access, you have a few different scenarios to consider. In the first scenario, you fill in a few pieces of data in different places on the worksheet. In the second scenario, you replace data that resembles a recordset. In the final scenario, you do a combination of the two. A combination could be a situating in which you change certain variables based on the number of records in a recordset, or possibly a situation in which you bring in a recordset and take other values from the database. A good example of the combination scenario is a profitability model, where sales are loaded from a recordset and specific pricing is entered as separate data points. Regardless of the scenario, the first few steps are the same when using VBA from Access. Just to open the existing Excel worksheet, you need an Excel ## Example 8-1. Generic procedure to open an existing workbookPublic Sub GetXLWB(fname As String, ByRef xlapp As Excel.Application, _ ByRef xlwb As Excel.Workbook) Set xlapp = New Excel.Application Set xlwb = xlapp.Workbooks.Open(fname) End Sub ## Example 8-2. Procedure that calls the procedure in 8-1 and returns a resultPublic Sub xlCallingProc( ) Dim xlapp As Excel.Application Dim xlwb As Excel.Workbook Dim xlws As Excel.Worksheet Call GetXLWB("C:\Devwork\Chapter8workbook.xls", xlapp, xlwb) Set xlws = xlwb.Sheets("Sheet1") MsgBox "The value in cell H5 is " & xlws.Range("H5").Value, vbInformation xlwb.Close xlapp.Quit Set xlws = Nothing Set xlwb = Nothing Set xlapp = Nothing End Sub If you look back at Figure 8-1, it shows a worksheet that calculates a total margin housed in cell H5. The procedure in Example 8-2 opens this workbook and returns the value in cell H5 in a message box. At this point, you know how to open a workbook and read a value from a worksheet. Let's look at a case, using the code in Example 8-3, where you want to open up each workbook in a directory of several workbooks and pull a recordset from the database based on the information in a cell. Then print the report if the ## Example 8-3. Processing multiple workbooksPublic Sub MultiProc(pname As String, printopt As Boolean) ' passes a parameter to a recordset to build a report Dim xlapp As Excel.Application Dim xlwb As Excel.Workbook Dim xlws As Excel.Worksheet Dim xlrng As Excel.Range Dim fname As String Dim param As String Dim x, y, z, a, b, c As Integer Dim db As DAO.Database Dim qry As DAO.QueryDef Dim rs As DAO.Recordset Set db = CurrentDb Set xlapp = New Excel.Application xlapp.Visible = True fname = Dir(pname & "*.xls") While fname <> "" Set xlwb = xlapp.Workbooks.Open(pname & fname) Set xlws = xlwb.Sheets("ReportParameters") Set qry = db.QueryDefs("qry_ExcelReport") param = xlws.Range("B2").Value qry.Parameters(0).Value = param Set rs = qry.OpenRecordset Set xlrng = xlwb.Sheets("ReportData").Range("A2") xlrng.CopyFromRecordset rs x = rs.RecordCount rs.Close Set xlws = xlwb.Sheets("Report") xlws.Cells(3, 1).Value = "Category" xlws.Cells(3, 2).Value = "Units" xlws.Cells(3, 3).Value = "Sales" Set xlrng = xlws.Range(xlws.Cells(3, 1), xlws.Cells(3, 3)) xlrng.Font.Bold = True Set qry = db.QueryDefs("qry_ExcelProducts") qry.Parameters(0).Value = param Set rs = qry.OpenRecordset Set xlrng = xlws.Range("A4") xlrng.CopyFromRecordset rs y = rs.RecordCount For b = 4 To y + 3 Set xlrng = xlws.Cells(b, 2) xlrng.FormulaArray = "=Sum((ReportData!R2C2:R" & x + 1 & _ "C2=Report!R" & b & "C1)*ReportData!R2C4:R" & _ x + 1 & "C4)" Set xlrng = xlws.Cells(b, 3) xlrng.FormulaArray = "=Sum((ReportData!R2C2:R" & x + 1 & _ "C2=Report!R" & b & "C1)*ReportData!R2C5:R" & _ x + 1 & "C5)" Next b Set xlrng = xlws.Range(xlws.Cells(4, 2), xlws.Cells(y + 3, 2)) xlrng.NumberFormat = "#,##0" Set xlrng = xlws.Range(xlws.Cells(4, 3), xlws.Cells(y + 3, 3)) xlrng.NumberFormat = "$0.00" rs.Close z = y + 5 xlws.Cells(z, 1).Value = "Center" xlws.Cells(z, 2).Value = "Units" xlws.Cells(z, 3).Value = "Sales" Set xlrng = xlws.Range(xlws.Cells(z, 1), xlws.Cells(z, 3)) xlrng.Font.Bold = True z = z + 1 Set qry = db.QueryDefs("qry_ExcelCenters") qry.Parameters(0).Value = param Set rs = qry.OpenRecordset Set xlrng = xlws.Cells(z, 1) xlrng.CopyFromRecordset rs a = z + rs.RecordCount For b = z To a - 1 Set xlrng = xlws.Cells(b, 2) xlrng.FormulaArray = "=Sum((ReportData!R2C1:R" & x + 1 & _ "C1=Report!R" & b & "C1)*ReportData!R2C4:R" & _ x + 1 & "C4)" Set xlrng = xlws.Cells(b, 3) xlrng.FormulaArray = "=Sum((ReportData!R2C1:R" & x + 1 & _ "C1=Report!R" & b & "C1)*ReportData!R2C5:R" & _ x + 1 & "C5)" Next b Set xlrng = xlws.Range(xlws.Cells(z, 2), xlws.Cells(a - 1, 2)) xlrng.NumberFormat = "#,##0" Set xlrng = xlws.Range(xlws.Cells(z, 3), xlws.Cells(a - 1, 3)) xlrng.NumberFormat = "$0.00" xlws.Columns.AutoFit If printopt Then xlws.PrintOut xlwb.SaveAs "C:\Reports\" & fname xlwb.Close Set xlwb = Nothing fname = Dir Wend Set xlrng = Nothing Set xlws = Nothing xlapp.Quit Set xlapp = Nothing rs.Close qry.Close Set rs = Nothing Set qry = Nothing Set db = Nothing End Sub I should point out a few things here. First, I use an array function instead of the Here is how the procedure works. By passing a path name, the Call multiproc("C:\DevWork\Chapter8\",TRUE) Again, this assumes that you have Excel documents in a directory called C:\DevWork\Chapter8\. If there are no Excel files in that directory, it fails to do anything. It also assumes that the Excel workbooks have a sheet called "ReportParameters." Note that I have reused the Because of the way this workbook is set up, you could pull the line of business names from the database and open one Excel Workbook as a template. Then just update the line of business names on the You may also notice that while Example 8-2 uses a report template, the formulas are still created by Access. You can just as easily have a template where you only update data and do not create formulas. In this case, it is necessary to rewrite the formulas because the number of categories can change between each workbook. |

< Day Day Up > |

Integrating Excel and Access

ISBN: 0596009739

EAN: 2147483647

EAN: 2147483647

Year: 2005

Pages: 132

Pages: 132

Authors: Michael Schmalz

flylib.com © 2008-2017.

If you may any questions please contact us: flylib@qtcs.net

If you may any questions please contact us: flylib@qtcs.net