change report format

Private Sub cmdCetak_Click()


On Error Resume Next
Dim lc, NxtLine, k
    If Trim(cmbSesi.Text) <> "" And Trim(cmbSem.Text) <> "" And Trim(cmbPgjn.Text) <> "" & _
    Trim(cmbIjzh.Text) <> "" And Trim(cmbJbtn.Text) <> "" Then
        Screen.MousePointer = vbHourglass
        Connect ' function from Module1.bas
        Set ExlObj = CreateObject("excel.application")      ' Initialize the excel object
        ExlObj.Workbooks.Add                                ' Add an excel workbook
        ' Get the required data from the database
        rsGetAllData.Open "select P.pel_nomatriks, P.pel_nama, T.tes_tajuk, T.tes_bidang from " & _
                 "pelajar P, tesis T " & _
                 "where P.pel_ID = T.pel_ID " & _
                 "And P.pel_tahundaftar = '" & cmbSesi.Text & "' And P.pel_semdaftar = '" & cmbSem.Text & "' " & _
                 "And P.pel_pengajian = '" & cmbPgjn.Text & "' And P.pel_ijazah = '" & cmbIjzh.Text & "' " & _
                 "And P.pel_jabatan = '" & Trim(cmbJbtn.Text) & "'", con, adOpenDynamic, adLockOptimistic
        If Not rsGetAllData.EOF Then
          ExlObj.Visible = True
          With ExlObj.ActiveSheet
            ' Print the heading and columns
               .Cells(1, 1).Value = "BAHAGIAN IJAZAH TINGGI"
            .Cells(1, 1).Font.name = "Verdana"
               .Cells(1, 1).Font.Bold = True:
               .Cells(2, 1).Value = "AKADEMI PENGAJIAN ISLAM"
               .Cells(3, 1).Value = "UNIVERSITI MALAYA"
               .Cells(5, 1).Value = "LAPORAN SENARAI NAMA PELAJAR DAN TAJUK TESIS"
               .Cells(7, 1).Value = "PENGAJIAN : " & cmbPgjn.Text
               .Cells(8, 1).Value = "IJAZAH : " & cmbIjzh.Text
               .Cells(9, 1).Value = "JABATAN : " & cmbJbtn.Text
               .Cells(10, 1).Value = "SESI : " & cmbSesi.Text
               .Cells(11, 1).Value = "SEMESTER : " & cmbSem.Text
               .Cells(13, 1).Value = "Bil":  .Cells(13, 2).Value = "No Matriks"
               .Cells(13, 3).Value = "Nama": .Cells(13, 4).Value = "Tajuk"
               .Cells(13, 5).Value = "Bidang"
          End With
        End If
        For k = 1 To rsGetAllData.Fields.Count
             ExlObj.ActiveSheet.Cells(14, k).Font.Bold = True
        Next
        Set k = Nothing
        NxtLine = 14
        varCount = 1
        Do Until rsGetAllData.EOF
            For lc = 0 To rsGetAllData.Fields.Count - 1
                ' Populate numbering into the sheet
                ExlObj.ActiveSheet.Cells(NxtLine, 1).Value = varCount
                ' Populate data into the sheet
                ExlObj.ActiveSheet.Cells(NxtLine, lc + 2).Value = rsGetAllData.Fields(lc)
                ' Autoformat the sheet
                ExlObj.ActiveCell.Worksheet.Cells(NxtLine, lc + 2).AutoFormat _
                       xlRangeAutoFormatList2, 0, regular, 3, 1, 1
            Next
            rsGetAllData.MoveNext
            NxtLine = NxtLine + 1
            varCount = varCount + 1
        Loop
        ' Display total number of records
        ExlObj.ActiveSheet.Cells(NxtLine, 1).Value = "Jumlah:"
        ExlObj.ActiveSheet.Cells(NxtLine, 1).Font.name = "Verdana"
        ExlObj.ActiveSheet.Cells(NxtLine, 1).Font.Bold = True:
        ExlObj.ActiveSheet.Cells(NxtLine, 2).Value = varCount - 1
        ExlObj.ActiveSheet.Cells(NxtLine, 2).Font.name = "Verdana"
        ExlObj.ActiveSheet.Cells(NxtLine, 2).Font.Bold = True:
        
        Screen.MousePointer = vbDefault
    Else
        MsgBox "Sila pilih jabatan" & Chr(13) & "dan teruskan"
        Screen.MousePointer = vbDefault
        Exit Sub
    End If
End Sub