' Subroutine to create an excel work sheet having data from a RecordSet
Public Sub ExcelSheetGeneration(ByVal arg_RecordSet As ADODB.Recordset)
' Creating Excel workbook with three sheets
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
Dim iCols As Integer
DoCmd.Hourglass True
'Formatting of excel sheet
'Set row 1 text, bold and center
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, arg_RecordSet .Fields.count)).NumberFormat = "@"
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, arg_RecordSet .Fields.count)).Font.Bold = True
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(1, arg_RecordSet .Fields.count)).HorizontalAlignment = xlCenter
'Get column names for excel worksheet from recoedsheet
For iCols = 0 To arg_RecordSet .Fields.count - 1
'Look for Excel override column name. If not, then look for regular Display Column name.
xlSheet.Cells(1, iCols + 1).Value = arg_RecordSet .Fields(iCols).Name
Next
'Load spreadsheet
xlSheet.Cells(2, 1).CopyFromRecordset arg_RecordSet
On Error GoTo Error_Exit
'Formatting of excel sheet
xlSheet.Columns("A:BB").Columns.AutoFit
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(65536, arg_RecordSet .Fields.count)).VerticalAlignment = xlCenter
xlSheet.Range(xlSheet.Cells(1, 1), _
xlSheet.Cells(65536, arg_RecordSet .Fields.count)).WrapText = True
xlBook.Sheets("Sheet1").Select
xlBook.Sheets("Sheet1").Name = Left("Excel Work Sheet Name", 31)
xlBook.Application.Visible = True
xlApp.ActiveWindow.FreezePanes = True
Normal_Exit:
DoCmd.Hourglass False
Set xlSheet = Nothing
Set arg_RecordSet = Nothing
Exit Sub
Error_Exit:
DoCmd.Hourglass False
MsgBox Err.Number & "-" & Err.Description
Resume Normal_Exit
End Sub
No comments:
Post a Comment