Artikel ini saya peroleh dari http://support.microsoft.com/kb/289793, kemudian saya praktekkan dan akhirnya berhasil, hehehe. Selanjutnya sedikit saya modifikasi agar user dapat memilih grouping berdasarkan field yang dipilih.
Sebagai contoh saya menyiapkan sebuah tabel dengan Microsoft Access dengan susunan field sebagai berikut :
1. Nama
2. Umur
3. Pekerjaan
4. Kota Asal
Selanjutnya buka Visual Basic 6.0
Buka standard EXE Project pada Visual Basic 6.0
Tambahkan command button dan combobox
Klik menu Project, klik Add DataReport. Apabila Add Datareport tidak ada dalam menu Project, Tambahkan melalui tab Designers yang terletak dalam menu Project >> Component.
Buka DataReport1, Apabila Report Header/Footer (Section4) ada didalamnya, hapus dengan cara klik kanan report Kemudian hilangkan tanda contreng pada "Show Report Header/Footer�.
Klik kanan dan pilih Insert Group Header/Footer. sebuah section baru, section4, telah ditambahkan dalam report.
Tambahkan 5 buah RptLabel dan satu buah RptTextBox kedalam section4, Tambahkan 4 buah RptTextBox kedalam Detail Section dan susun seperti gambar dibawah ini :
Sekarang kita mulai Codingnya :
�Deklarasi componentDim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim rs1 As New ADODB.Recordset� FORM LOADPrivate Sub Form_Load()�Membuka koneksi database
cn.Open "Provider=MSDATASHAPE; Data Provider=Microsoft.JET.OLEDB.4.0;" + _
"Data Source=" + App.Path + "\Data1.mdb"�Menambahkan field pada combo secara manualCombo1.Clear
Combo1.AddItem "Pekerjaan"
Combo1.AddItem "Umur"
Combo1.AddItem "Kota_asal"
Command1.Caption = "Show Report"
End Sub�Koneksi ReportSub groupCommand(groups As String)
On Error Resume Next
rs.Close�Menyiapkan koneksi record group ke dalam reportWith cmd
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = " SHAPE {SELECT nama,umur,pekerjaan,kota_asal FROM `pekerjaan`} AS Command1 COMPUTE Command1 BY '" + groups + "'"
.Execute
End With
With rs
.ActiveConnection = cn
.CursorLocation = adUseClient
.Open cmd
End With
Set rs1 = rs(0).Value
End Sub�Menampilkan Report
Sub showReport(groups As String)
On Error Resume Next
Dim q As Integer
Dim intCtrl As Integer
Dim x As Integer
Dim z As Integer
x = 0
q = 0
z = 0
groupCommand groups
With DataReport1
.Hide
Set .DataSource = rs
.DataMember = ""
With .Sections("section4").Controls
If TypeOf .Item(1) Is RptLabel Then .Item(1).Caption = Replace(groups, "_", " ") + " :"
If TypeOf .Item(3) Is RptLabel Then .Item(3).Caption = "Nama"
If TypeOf .Item(4) Is RptLabel Then .Item(4).Caption = "Umur"
If TypeOf .Item(5) Is RptLabel Then .Item(5).Caption = "Pekerjaan"
If TypeOf .Item(6) Is RptLabel Then .Item(6).Caption = "Kota Asal"
�if TypeOf .Item(x) Is RptLabel Then .Item(x).Caption = "Kota Asal", index �tanda x dalam kurung setelah item, harus anda sesuaikan dengan cara trial and error, karena bisa saja index �tanda x dalam kurung� tidak ada jadi harus diganti dengan angka yang lain
For intCtrl = 1 To .Count
If TypeOf .Item(intCtrl) Is RptTextBox Then
.Item(intCtrl).DataMember = ""
.Item(intCtrl).DataField = groups
End If
Next
End With
q = 0
With .Sections("Section1").Controls
For intCtrl = 1 To .Count
If TypeOf .Item(intCtrl) Is RptTextBox Then
.Item(intCtrl).DataMember = "Command1"
.Item(intCtrl).DataField = rs1(z).Name
z = z + 1
End If
Next intCtrl
End With
.WindowState = vbMaximized
.Refresh
.Show
End With
End Sub�Menampilkan ReportPrivate Sub Command1_Click()
showReport Combo1.Text
End Sub
Simak, Salin dan Tempel code diatas ini kedalam form Anda.
Good Luck :)
Berikut kurang lebih tampilan akhirnya (dengan group by �Pekerjaan�):
Untuk Source codenya dapat Anda lihat diposting sebelumnya.
Update Contact :
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email : Fajarudinsidik@gmail.com
No Wa/Telepon (puat) : 085267792168
No Wa/Telepon (fajar) : 085369237896
Email: Fajarudinsidik@gmail.com
atau Kirimkan Private messanger melalui email dengan klik tombol order dibawah ini :
