VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cls_Excel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mrs_Data As ADODB.Recordset
Private mstr_Company As String
Private mstr_Title As String
Private mstr_ReportDate As String
Private objExcelApp As Object

Property Get Recordset() As ADODB.Recordset
    Set Recordset = mrs_Data
End Property

Property Set Recordset(rs As ADODB.Recordset)
    Set mrs_Data = rs
    mrs_Data.Filter = rs.Filter
End Property

Property Let Company(data As String)
    mstr_Company = data
End Property

Property Let Title(data As String)
    mstr_Title = data
End Property

Property Let ReportDate(data As Date)
    mstr_ReportDate = "As of date : " & Format(data, "dd/mmm/yyyy")
End Property

Public Sub ExportRStoExcel()
    Dim objWorkbook As Object
    Dim objWorksheet As Object
    Dim objRange As Object
    Dim objField As ADODB.Field
    Dim i As Integer

    ' Run Excel and open a new workbook
    Set objWorkbook = objExcelApp.Workbooks.Add

    ' Get a reference to the first worksheet
    Set objWorksheet = objWorkbook.Sheets(1)
    objWorksheet.Name = "Data"

    ' Get a range reference for the first row
    Set objRange = objWorksheet.Range("A1")
    objRange.Cells(1, 1) = mstr_Company

    Set objRange = objWorksheet.Range("A2")
    objRange.Cells(1, 1) = mstr_Title
    
    Set objRange = objWorksheet.Range("A3")
    objRange.Cells(1, 1) = mstr_ReportDate
    
    Set objRange = objWorksheet.Range("A5")
    ' Loop through the fields and put the field name in the first row
    i = 0
    For Each objField In mrs_Data.Fields
        i = i + 1
        objRange.Cells(1, i) = objField.Name
    Next

    ' Get a reference to the second row
    Set objRange = objWorksheet.Range("A6")

    ' Copy recordset to the range starting from the second row
    Call objRange.CopyFromRecordset(mrs_Data, mrs_Data.RecordCount, mrs_Data.Fields.Count)

    ' Bold the first row
    objWorksheet.Rows("1:5").Font.Bold = True
    objWorksheet.Range("A5").Select
    objWorksheet.PivotTableWizard
    objWorkbook.ActiveSheet.Name = "Pivot"
    objWorksheet.Select
    ' Expend the columns to show entire content
    'objWorksheet.Cells.EntireColumn.AutoFit

    ' Show Excel Sheet to user
    objWorksheet.Move objWorkbook.Sheets("Pivot")
    objExcelApp.Visible = True

    ' Return Excel Sheet to calling routine
    'Set ExportRStoExcel = objWorksheet
End Sub

Private Sub Class_Initialize()
    Set mrs_Data = New ADODB.Recordset
    Set objExcelApp = CreateObject("Excel.Application")
End Sub

Private Sub Class_Terminate()
    Set mrs_Data = Nothing
    Set objExcelApp = Nothing
End Sub
