|
Numbering and count total data.
code below i found it from internet. it's ok and could run on my system where the data can be exported from the system in vb6 to ms excel. i want to make some adjustment in terms of numbering and total number of data. based on the original coding, the result in the ms excel does not show these two things. i have tried to edit the code, but still did not work. i would like to show the numbering at before the No Pelajar's cell and at the bottom of all records will show the total number of records. here is my the code. i do not completely understand at the Italic+Bold codes.
Code:
If 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_ID, P.pel_nama, T.tes_tajuk from " & _
"pelajar P, tesis T " & _
"where P.pel_ID = T.pel_ID " & _
"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, 3).Value = "SENARAI NAMA DAN TAJUK TESIS. BAHAGIAN : "
.Cells(1, 3).Font.name = "Verdana"
.Cells(1, 3).Font.Bold = True: .Cells(1, 5).Value = cmbJbtn.Text
.Cells(4, 1).Value = "No Pelajar": .Cells(4, 2).Value = "No Matrik"
.Cells(4, 3).Value = "Tajuk Tesis"
End With
End If
For k = 1 To rsGetAllData.Fields.Count
ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
Next
Set k = Nothing
NxtLine = 5
Do Until rsGetAllData.EOF
For lc = 0 To rsGetAllData.Fields.Count - 1
' Populate data into the sheet
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
If rsGetAllData.Fields.Item(lc).Name <> "DATE" Then
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
Else
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = Format(rsGetAllData.Fields(lc), "dd/mm/yy")
End If
' Autoformat the sheet
ExlObj.ActiveCell.Worksheet.Cells(NxtLine, lc + 1).AutoFormat _
xlRangeAutoFormatList2, 0, regular, 3, 1, 1
Next
rsGetAllData.MoveNext
NxtLine = NxtLine + 1
Loop
' Calculate the total
ExlObj.ActiveCell.Worksheet.Cells(4, 1).Subtotal 4, xlSum, (6), 0, 0, xlSummaryBelow
Screen.MousePointer = vbDefault
Else
MsgBox "Please select a code" & Chr(13) & "and then proceed"
Screen.MousePointer = vbDefault
Exit Sub
here is the original code.
Code:
On Error Resume Next
Dim lc, NxtLine, k
If Trim(LstCode.Text) <> "" Then
Screen.MousePointer = vbHourglass
Connect
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 ACCODE,CONTROL,TRNOS,DATE,TRCODE,AMOUNT,STAFFNOS from " & _
"TRPC0104 where TRCODE = '" + Trim(LstCode.Text) + "'", con, adOpenDynamic, adLockOptimistic
If Not rsGetAllData.EOF Then
ExlObj.Visible = True
With ExlObj.ActiveSheet
' Print the heading and columns
.Cells(1, 3).Value = "VB TO EXCEL DEMO by Arun Banik"
.Cells(1, 3).Font.Name = "Verdana"
.Cells(1, 3).Font.Bold = True:
.Cells(4, 1).Value = "AC-Code": .Cells(4, 2).Value = "Control"
.Cells(4, 3).Value = "TR-Nos": .Cells(4, 4).Value = "Date"
.Cells(4, 5).Value = "TR-Code": .Cells(4, 6).Value = "Amount"
.Cells(4, 7).Value = "Staff Nos"
End With
End If
For k = 1 To rsGetAllData.Fields.Count
ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
Next
Set k = Nothing
NxtLine = 5
Do Until rsGetAllData.EOF
For lc = 0 To rsGetAllData.Fields.Count - 1
' Populate data into the sheet
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
If rsGetAllData.Fields.Item(lc).Name <> "DATE" Then
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = rsGetAllData.Fields(lc)
Else
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = Format(rsGetAllData.Fields(lc), "dd/mm/yy")
End If
' Autoformat the sheet
ExlObj.ActiveCell.Worksheet.Cells(NxtLine, lc + 1).AutoFormat _
xlRangeAutoFormatList2, 0, regular, 3, 1, 1
Next
rsGetAllData.MoveNext
NxtLine = NxtLine + 1
Loop
' Calculate the total
ExlObj.ActiveCell.Worksheet.Cells(4, 1).Subtotal 4, xlSum, (6), 0, 0, xlSummaryBelow
Screen.MousePointer = vbDefault
Else
MsgBox "Please select a code" & Chr(13) & "and then proceed"
Screen.MousePointer = vbDefault
Exit Sub
End If
__________________
teach and correct me if i am wrong...
Last edited by wackyflik : May 21st, 2005 at 11:36 AM.
|
ASP Free Forums Sponsor:
May 21st, 2005, 11:29 AM
Del.icio.us
Digg
Google
Spurl
Blink
Furl
Simpy
Y! MyWeb
Linear Mode
