HI all,
I've got a module in Access97 that I'm using to update a graph in Excel for patient registrations (by hour) to an ER by their acuity. In Access I create the graph a few ways for each month (weekdays, weekends, all days)... so I want to put the path of the saved file in the footer. I'm currently doing it manually because I can't seem to figure out how to make the footer update.
I've got two tabs on my template spreadsheet. One called "query" that holds all the data in ranges, and one called "results" that is the graph. This is the one I want the footer to update on.
Here's my code so far, and everything works: (I adapted it from the Access 97 Developer's Handbook by Litwin, Getz, and Gilbert). Closer to end of the code I have commented in CAPS where I think I need to do it and what I'm trying...
Option Compare Database
Option Explicit
Public Function adhUpdateAcuity()
' Object variables for Automation stuff
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objQuerySheet As Excel.Worksheet
Dim objResultsSheet As Excel.Chart
Dim objXLRange As Excel.Range
' DAO and other variables
Dim db As Database
Dim qdf As QueryDef
Dim rst As Recordset
Dim varResults As Variant
Dim varIATACode As Variant
Dim varHour0 As Variant
Dim varHour1 As Variant
Dim varHour2 As Variant
Dim varHour3 As Variant
Dim varHour4 As Variant
Dim varHour5 As Variant
Dim varHour6 As Variant
Dim varHour7 As Variant
Dim varHour8 As Variant
Dim varHour9 As Variant
Dim varHour10 As Variant
Dim varHour11 As Variant
Dim varHour12 As Variant
Dim varHour13 As Variant
Dim varHour14 As Variant
Dim varHour15 As Variant
Dim varHour16 As Variant
Dim varHour17 As Variant
Dim varHour18 As Variant
Dim varHour19 As Variant
Dim varHour20 As Variant
Dim varHour21 As Variant
Dim varHour22 As Variant
Dim varHour23 As Variant
Dim varStart As Variant
Dim varEnd As Variant
Dim intCount As Integer
' Constants for the XLS file and directory
Const adhcXLSName = "AcuityTemplate.xls"
Const adhcXLSPath = "X:\clinical query\EmergPGC\"
' Go ahead and create an object from the XLS file
Set objXLBook = GetObject(adhcXLSPath & adhcXLSName)
' We can use the Parent
' property of the workbook object
' to get a pointer to Excel's
' Application object
Set objXLApp = objXLBook.Parent
' Set object references for the
' workbook's two worksheets
Set objQuerySheet = objXLBook.Worksheets("Query")
Set objResultsSheet = objXLBook.Charts("Results")
' Make sure both Excel and the
' workbook are visible (they won't
' be if Excel was launched by our
' Automation request)
objXLApp.Visible = True
objXLBook.Windows(1).Visible = True
varHour0 = objQuerySheet.Range("Hour0")
varHour1 = objQuerySheet.Range("Hour1")
varHour2 = objQuerySheet.Range("Hour2")
varHour3 = objQuerySheet.Range("Hour3")
varHour4 = objQuerySheet.Range("Hour4")
varHour5 = objQuerySheet.Range("Hour5")
varHour6 = objQuerySheet.Range("Hour6")
varHour7 = objQuerySheet.Range("Hour7")
varHour8 = objQuerySheet.Range("Hour8")
varHour9 = objQuerySheet.Range("Hour9")
varHour10 = objQuerySheet.Range("Hour10")
varHour11 = objQuerySheet.Range("Hour11")
varHour12 = objQuerySheet.Range("Hour12")
varHour13 = objQuerySheet.Range("Hour13")
varHour14 = objQuerySheet.Range("Hour14")
varHour15 = objQuerySheet.Range("Hour15")
varHour16 = objQuerySheet.Range("Hour16")
varHour17 = objQuerySheet.Range("Hour17")
varHour18 = objQuerySheet.Range("Hour18")
varHour19 = objQuerySheet.Range("Hour19")
varHour20 = objQuerySheet.Range("Hour20")
varHour21 = objQuerySheet.Range("Hour21")
varHour22 = objQuerySheet.Range("Hour22")
varHour23 = objQuerySheet.Range("Hour23")
varStart = Forms![frmGraphGeneration]![StartDate]
varEnd = Forms![frmGraphGeneration]![EndDate]
'Run the query to create the data
Set db = CurrentDb
Dim qnamep1 As String
Dim lnamep2 As String
Dim qnamep3 As String
Dim dnamep4 As String
Dim qname As String
qnamep1 = "qryTriageLevelsByHourDR"
lnamep2 = Forms![frmGraphGeneration]![Locator]
qnamep3 = "Summary"
dnamep4 = Forms![frmGraphGeneration]![Days]
qname = qnamep1 & lnamep2 & qnamep3 & dnamep4
Set qdf = db.QueryDefs(qname)
qdf![Forms!frmGraphGeneration!StartDate] = Forms![frmGraphGeneration]![StartDate]
qdf![Forms!frmGraphGeneration!EndDate] = Forms![frmGraphGeneration]![EndDate]
Set rst = qdf.OpenRecordset '(dbOpenSnapshot)
' Snag all the results into an array using GetRows
varResults = rst.GetRows(31)
rst.Close
db.Close
' Let's start by clearing the data
' range on the results worksheet--
' we'll use the rngDataAll range
objQuerySheet.Range("rngDataAll").Clear
' Determine the range where the data
' will go based on the number of rows
' in the results
Set objXLRange = objQuerySheet.Range("A2:AB6") ' & 4 + UBound(varResults, 2))
' Slam the data in using the FormulaArray
' method (but we have to transpose it
' first because it's oriented wrong)
objXLRange.FormulaArray = objXLApp.Transpose(varResults)
' Now that the data is there let's
' reset the source range for the chart
' (this is pretty hefty Excel VBA code!)
'objQuerySheet.ChartObjects(1).Chart.ChartWizard Source:=objXLApp. _
'Union(objQuerySheet.Range("E2:E6"), objXLRange)
' Update the cells on the Query worksheet
objQuerySheet.Range("rngStart").Formula = Forms![frmGraphGeneration]![StartDate]
objQuerySheet.Range("rngEnd").Formula = Forms![frmGraphGeneration]![EndDate]
objQuerySheet.Range("rngLocator").Formula = Forms![frmGraphGeneration]![Locator]
objQuerySheet.Range("rngDays").Formula = Forms![frmGraphGeneration]![Days]
objQuerySheet.Range("rngUpdate").Formula = Now
With objResultsSheet
.HasTitle = True
With .ChartTitle
.Characters.Text = objQuerySheet.Range("rngChartTitle")
.Font.Size = 12
End With
End With
'THIS IS WHERE I THINK I NEED TO UPDATE THE FOOTER
'BUT THIS DOESN'T WORK
'IT DOESN'T LIKE THE .LeftFooter
'With objResultsSheet
' .PageSetup.LeftFooter
' .Characters.Text = objQuerySheet.Range("rngFooter")
' .Font.Size = 10
' .Font.Italic
'End With
' Now lets save the workbook and
' shut down Excel when we're done
objXLBook.Save
objXLApp.Quit
adhUpdateAcuity_Done:
On Error Resume Next
' Let's clean up our act
Set objResultsSheet = Nothing
Set objQuerySheet = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing
adhUpdateAcuity_Exit:
Exit Function
adhUpdateAcuity_Error:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
End Select
Resume adhUpdateAcuity_Done
End Function
Any suggestions anyone? Thanks in advance...
I've got a module in Access97 that I'm using to update a graph in Excel for patient registrations (by hour) to an ER by their acuity. In Access I create the graph a few ways for each month (weekdays, weekends, all days)... so I want to put the path of the saved file in the footer. I'm currently doing it manually because I can't seem to figure out how to make the footer update.
I've got two tabs on my template spreadsheet. One called "query" that holds all the data in ranges, and one called "results" that is the graph. This is the one I want the footer to update on.
Here's my code so far, and everything works: (I adapted it from the Access 97 Developer's Handbook by Litwin, Getz, and Gilbert). Closer to end of the code I have commented in CAPS where I think I need to do it and what I'm trying...
Option Compare Database
Option Explicit
Public Function adhUpdateAcuity()
' Object variables for Automation stuff
Dim objXLApp As Excel.Application
Dim objXLBook As Excel.Workbook
Dim objQuerySheet As Excel.Worksheet
Dim objResultsSheet As Excel.Chart
Dim objXLRange As Excel.Range
' DAO and other variables
Dim db As Database
Dim qdf As QueryDef
Dim rst As Recordset
Dim varResults As Variant
Dim varIATACode As Variant
Dim varHour0 As Variant
Dim varHour1 As Variant
Dim varHour2 As Variant
Dim varHour3 As Variant
Dim varHour4 As Variant
Dim varHour5 As Variant
Dim varHour6 As Variant
Dim varHour7 As Variant
Dim varHour8 As Variant
Dim varHour9 As Variant
Dim varHour10 As Variant
Dim varHour11 As Variant
Dim varHour12 As Variant
Dim varHour13 As Variant
Dim varHour14 As Variant
Dim varHour15 As Variant
Dim varHour16 As Variant
Dim varHour17 As Variant
Dim varHour18 As Variant
Dim varHour19 As Variant
Dim varHour20 As Variant
Dim varHour21 As Variant
Dim varHour22 As Variant
Dim varHour23 As Variant
Dim varStart As Variant
Dim varEnd As Variant
Dim intCount As Integer
' Constants for the XLS file and directory
Const adhcXLSName = "AcuityTemplate.xls"
Const adhcXLSPath = "X:\clinical query\EmergPGC\"
' Go ahead and create an object from the XLS file
Set objXLBook = GetObject(adhcXLSPath & adhcXLSName)
' We can use the Parent
' property of the workbook object
' to get a pointer to Excel's
' Application object
Set objXLApp = objXLBook.Parent
' Set object references for the
' workbook's two worksheets
Set objQuerySheet = objXLBook.Worksheets("Query")
Set objResultsSheet = objXLBook.Charts("Results")
' Make sure both Excel and the
' workbook are visible (they won't
' be if Excel was launched by our
' Automation request)
objXLApp.Visible = True
objXLBook.Windows(1).Visible = True
varHour0 = objQuerySheet.Range("Hour0")
varHour1 = objQuerySheet.Range("Hour1")
varHour2 = objQuerySheet.Range("Hour2")
varHour3 = objQuerySheet.Range("Hour3")
varHour4 = objQuerySheet.Range("Hour4")
varHour5 = objQuerySheet.Range("Hour5")
varHour6 = objQuerySheet.Range("Hour6")
varHour7 = objQuerySheet.Range("Hour7")
varHour8 = objQuerySheet.Range("Hour8")
varHour9 = objQuerySheet.Range("Hour9")
varHour10 = objQuerySheet.Range("Hour10")
varHour11 = objQuerySheet.Range("Hour11")
varHour12 = objQuerySheet.Range("Hour12")
varHour13 = objQuerySheet.Range("Hour13")
varHour14 = objQuerySheet.Range("Hour14")
varHour15 = objQuerySheet.Range("Hour15")
varHour16 = objQuerySheet.Range("Hour16")
varHour17 = objQuerySheet.Range("Hour17")
varHour18 = objQuerySheet.Range("Hour18")
varHour19 = objQuerySheet.Range("Hour19")
varHour20 = objQuerySheet.Range("Hour20")
varHour21 = objQuerySheet.Range("Hour21")
varHour22 = objQuerySheet.Range("Hour22")
varHour23 = objQuerySheet.Range("Hour23")
varStart = Forms![frmGraphGeneration]![StartDate]
varEnd = Forms![frmGraphGeneration]![EndDate]
'Run the query to create the data
Set db = CurrentDb
Dim qnamep1 As String
Dim lnamep2 As String
Dim qnamep3 As String
Dim dnamep4 As String
Dim qname As String
qnamep1 = "qryTriageLevelsByHourDR"
lnamep2 = Forms![frmGraphGeneration]![Locator]
qnamep3 = "Summary"
dnamep4 = Forms![frmGraphGeneration]![Days]
qname = qnamep1 & lnamep2 & qnamep3 & dnamep4
Set qdf = db.QueryDefs(qname)
qdf![Forms!frmGraphGeneration!StartDate] = Forms![frmGraphGeneration]![StartDate]
qdf![Forms!frmGraphGeneration!EndDate] = Forms![frmGraphGeneration]![EndDate]
Set rst = qdf.OpenRecordset '(dbOpenSnapshot)
' Snag all the results into an array using GetRows
varResults = rst.GetRows(31)
rst.Close
db.Close
' Let's start by clearing the data
' range on the results worksheet--
' we'll use the rngDataAll range
objQuerySheet.Range("rngDataAll").Clear
' Determine the range where the data
' will go based on the number of rows
' in the results
Set objXLRange = objQuerySheet.Range("A2:AB6") ' & 4 + UBound(varResults, 2))
' Slam the data in using the FormulaArray
' method (but we have to transpose it
' first because it's oriented wrong)
objXLRange.FormulaArray = objXLApp.Transpose(varResults)
' Now that the data is there let's
' reset the source range for the chart
' (this is pretty hefty Excel VBA code!)
'objQuerySheet.ChartObjects(1).Chart.ChartWizard Source:=objXLApp. _
'Union(objQuerySheet.Range("E2:E6"), objXLRange)
' Update the cells on the Query worksheet
objQuerySheet.Range("rngStart").Formula = Forms![frmGraphGeneration]![StartDate]
objQuerySheet.Range("rngEnd").Formula = Forms![frmGraphGeneration]![EndDate]
objQuerySheet.Range("rngLocator").Formula = Forms![frmGraphGeneration]![Locator]
objQuerySheet.Range("rngDays").Formula = Forms![frmGraphGeneration]![Days]
objQuerySheet.Range("rngUpdate").Formula = Now
With objResultsSheet
.HasTitle = True
With .ChartTitle
.Characters.Text = objQuerySheet.Range("rngChartTitle")
.Font.Size = 12
End With
End With
'THIS IS WHERE I THINK I NEED TO UPDATE THE FOOTER
'BUT THIS DOESN'T WORK
'IT DOESN'T LIKE THE .LeftFooter
'With objResultsSheet
' .PageSetup.LeftFooter
' .Characters.Text = objQuerySheet.Range("rngFooter")
' .Font.Size = 10
' .Font.Italic
'End With
' Now lets save the workbook and
' shut down Excel when we're done
objXLBook.Save
objXLApp.Quit
adhUpdateAcuity_Done:
On Error Resume Next
' Let's clean up our act
Set objResultsSheet = Nothing
Set objQuerySheet = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing
adhUpdateAcuity_Exit:
Exit Function
adhUpdateAcuity_Error:
Select Case Err.Number
Case Else
MsgBox Err.Description, vbExclamation, _
"Error " & Err.Number
End Select
Resume adhUpdateAcuity_Done
End Function
Any suggestions anyone? Thanks in advance...
