Format An Excel Template from Access Through Connection
Suppose you have a nicely formatted Excel worksheet, and you want to populate it from an Access Database. Access has the VBA tools to allow it to open, populate, format and print an external workbook/worksheet. Access's report writing capability is very flexible, but for really specialty reports, populating an external Excel worksheet provides many additional options for professional looking reports.
The code shown below is contained in a forms "vba back end", not in a standard module. The routine shown below is activated when a user clicks a custom print button on the main form. Make sure to include the Microsoft Excel Object Library which is located in the Visual Basic Environment (Alt-F11) under Tools, References.
Program Code
Private Sub cmdPrint_Click()
' **************************************************************
' Establish Database Query Connection
' **************************************************************
Dim db As DAO.Database
Dim recIn As DAO.Recordset
' **************************************************************
' Establish Excel Communications from Access
' **************************************************************
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSh As Excel.Worksheet
' **************************************************************
' Other Variables
' **************************************************************
Dim strMovementDate As String
Dim lngLoopCount As Long
Dim lngRowCount As Long
Dim dblBBLsInKegs As Double
Dim dblBBLsInCases As Double
' **************************************************************
' Verify That The Movement Template Exists
' **************************************************************
If Not FileExists("C:\BeerMovementTemplate\BeerMovementTicketTemplateV5.xlsx") Then
MsgBox ("Template C:\BeerMovementTemplate\BeerMovementTicketTemplateV5.xlsx Does Not Exist")
Exit Sub
End If
' **************************************************************
' Open the Excel Beer Movement Ticket Template
' **************************************************************
Set xlApp = New Excel.Application
Set xlWB = xlApp.Workbooks.Open("C:\BeerMovementTemplate\BeerMovementTicketTemplateV5.xlsx")
Set xlSh = xlWB.Sheets("BeerMovementTicket")
' **************************************************************
' Flush all form entries to the database
' **************************************************************
Me.Refresh
' **************************************************************
' Capture the Movement Oakshire Serial Number to Print
' **************************************************************
gblOakshireSerialNumber = Me.OakshireSerialNumber
' **************************************************************
' Populate the Template With Beer Movement Data
' **************************************************************
' ***********************************************************************
' Open the Movement Query
' ***********************************************************************
Set db = CurrentDb()
Set recIn = db.OpenRecordset("qryForPrintingTicket")
' ***********************************************************************
' Loop Through Each Record And Populate The Excel Form
' ***********************************************************************
lngLoopCount = 1
lngRowCount = 10
dblBBLsInKegs = 0
dblBBLsInOther = 0
Do
If lngLoopCount = 1 Then
xlSh.Range("A3") = WeekdayName(Weekday(Me.MovementDate)) & ", " & Format(Me.MovementDate, "MMMM, DD, YYYY")
xlSh.Range("C5") = recIn!OakshireSerialNumber
xlSh.Range("B8") = recIn!FromSite
xlSh.Range("C8") = recIn!FromAddress
xlSh.Range("B9") = recIn!ToSite
xlSh.Range("C9") = recIn!ToAddress
End If
lngLoopCount = lngLoopCount + 1
lngRowCount = lngRowCount + 1
If lngRowCount > 29 Then
MsgBox ("Exceeded Maximums Rows For Movement Ticket")
Exit Sub
End If
xlSh.Cells(lngRowCount, "A") = recIn!ItemID
xlSh.Cells(lngRowCount, "B") = recIn!Brand
xlSh.Cells(lngRowCount, "C") = recIn!PackageSize
xlSh.Cells(lngRowCount, "D") = recIn!Quantity
xlSh.Cells(lngRowCount, "F") = recIn!Weight
xlSh.Cells(lngRowCount, "G") = recIn!TotalBBLs
dblBBLsInKegs = dblBBLsInKegs + Nz(recIn!BBLSInKegs, 0)
dblBBLsInCases = dblBBLsInCases + Nz(recIn!BBLSInCases, 0)
recIn.MoveNext
Loop Until recIn.EOF
recIn.Close
Set recIn = Nothing
Set db = Nothing
' ***********************************************************************
' Finish Populating the Worksheet
' ***********************************************************************
xlSh.Range("G33") = dblBBLsInKegs
xlSh.Range("G34") = dblBBLsInCases
xlSh.PrintOut
xlApp.DisplayAlerts = False
xlWB.Close SaveChanges:=False
xlApp.DisplayAlerts = True
xlApp.Quit
Set xlApp = Nothing
End Sub
Public Function FileExists(FilePath As String) As Boolean
' *******************************************************************************************
' * THIS FUNCTION WILL TEST IF A FILE EXISTS *
' *******************************************************************************************
On Error GoTo err_In_Locate
' ***********************************************************
' * See If A File Exists - Provide The Full Path to the File
' ***********************************************************
FileExists = (Len(Dir(FilePath)) > 0)
mod_ExitFunction:
Exit Function
' ***************************************************
' * Error Correction Routines *
' ***************************************************
err_In_Locate:
FileExists = False
Resume mod_ExitFunction
End Function