Export to excel from ADO, and change the names of a columns

[Fraps]

Hi abhijit

here below is my code ( class module ):

Public Sub ExportToExcel(Optional SaveFile As Boolean = False, _
                         Optional VisibleInstance As Boolean = True, _
                         Optional Password As String = "", _
                         Optional WriteResPassword As String = "", _
                         Optional ReadOnlyRecommended As Boolean = False, _
                         Optional HeaderFont As String = "Tahoma", _
                         Optional HeaderFontSize As Integer = 9)

Dim iRowIndex As Integer, avRows As Variant, ErrorOccured As Boolean
Dim iFieldCount As Integer, objExcel As Object, objTemp As Object
Dim iColIndex As Integer, iRecordCount As Integer

'I know that some tweaking are left here... I gave priority to compability here

    On Error GoTo hell

    RaiseEvent ExportStarted(EXCEL)

    With ADODBRecordset
        .MoveFirst
        avRows = .GetRows()                  'Read all the records in an
        iRecordCount = UBound(avRows, 2) + 1 'array and determine how
        iFieldCount = UBound(avRows, 1) + 1  'many fields in an array
        Set objExcel = CreateObject("Excel.Application")
        objExcel.Visible = VisibleInstance
        objExcel.Workbooks.Add

        Set objTemp = objExcel           'Ensure excel remains visible

        If Val(objExcel.Application.Version) >= 8 Then
            Set objExcel = objExcel.ActiveSheet
        End If

        iRowIndex = 1

        'Place Name of the fields
        For iColIndex = 1 To iFieldCount
            With objExcel.Cells(iRowIndex, iColIndex)
                .Value = ADODBRecordset.Fields(iColIndex - 1).Name
                With .Font
                    .Name = HeaderFont      'Make the headers stand out
                    .Size = HeaderFontSize
                    .Bold = True
                End With
            End With
        Next iColIndex

    End With

    With Progress
        .Min = 0
        .Max = ADODBRecordset.RecordCount
        .Value = 0
    End With

    With objExcel
        
        For iRowIndex = 2 To iRecordCount + 1
            For iColIndex = 1 To iFieldCount
                .Cells(iRowIndex, iColIndex) = avRows(iColIndex - 1, iRowIndex - 2)
            Next iColIndex
            Progress.Value = Progress.Value + 1
            DoEventsEx
        Next iRowIndex
        .Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
        If SaveFile Then
            .SaveAs ExportFilePath, , Password, WriteResPassword, ReadOnlyRecommended
        End If
    End With
    
    If Not VisibleInstance Then objExcel.Application.Quit
    Set objTemp = Nothing
    Set objExcel = Nothing
    
    RaiseEvent ExportComplete(Not ErrorOccured, EXCEL)

Exit Sub

hell:
    RaiseEvent ExportError(Err, EXCEL)
    If Err.Number = 0 Then
        Resume Next
        ErrorOccured = True
    End If

End Sub

Export to excel sheet works very well, only what I wanna do is to change the cell names in excel on A1, B1, C1, and so on.

And this is my sheet. Is there any way to change the cells showed above as ID, CM1, CM2 for Index, Index2...

Regards.