Cara Membuat Laporan Berdasarkan Kriteria dan Terbilang Vb 6.0 - Hey Kawan Relainc Andro, saatnya kita membuat laporan menggunakan VB 6.0 membuat laporan gampang - gampang susah. namun buat yang sudah biasa ini bukan hal yang sulit untuk dilakukan.
Yaitu Sebagi berikut untuk Gambaran Source Codenya :
Terima Kasih Kawan Semoga Artikel Cara Membuat Laporan Berdasarkan Kriteria dan Terbilang Vb 6.0 Bermanfaat buat teman teman.
 |
| Contoh Laporan berdasarkan Kriteria -Relainc Andro- |
Yaitu Sebagi berikut untuk Gambaran Source Codenya :
Dim DT As ADODB.ConnectionJika ingin Mendownload Source Codenya bisa Download Disini. atau di Bawah ini.
Dim JumlahTagihan As Double
Public Sub KONEKSI()
Set DT = New ADODB.Connection
DT.CursorLocation = adUseClient
DT.Open ("Provider=Microsoft.Jet.Oledb.4.0;Data Source=n.mdb")
End Sub
Sub HitungJumlahTagihan()
Dim DB As New ADODB.Recordset
DB.Open ("select Tagihan from Tbl_KetLap where Keterangan='" & CboKet.Text & "' and Tanggal>=#" & Format(DateSerial(Val(cmbTahun1.Text), NilaiBulan(cmbBulan1.Text), 1), "MM/dd/yyyy") & "# and Tanggal<=#" & Format(DateSerial(Val(cmbTahun2.Text), NilaiBulan(cmbBulan2.Text), AkhirBulan(NilaiBulan(cmbBulan2.Text))), "MM/dd/yyyy") & "#"), DT, adOpenDynamic, adLockOptimistic
JumlahTagihan = 0
If DB.RecordCount <> 0 Then
DB.MoveFirst
While Not DB.EOF
JumlahTagihan = JumlahTagihan + Val(DB!Tagihan)
DB.MoveNext
Wend
End If
End Sub
Sub TampilkanDatagrid()
Dim YULIAN As New ADODB.Recordset
YULIAN.Open ("select id_pelanggan, nama_pelanggan, alamat_pelanggan, tanggal, tagihan, keterangan from Tbl_KetLap where Keterangan='" & CboKet.Text & "' and Tanggal>=#" & Format(DateSerial(Val(cmbTahun1.Text), NilaiBulan(cmbBulan1.Text), 1), "MM/dd/yyyy") & "# and Tanggal<=#" & Format(DateSerial(Val(cmbTahun2.Text), NilaiBulan(cmbBulan2.Text), AkhirBulan(NilaiBulan(cmbBulan2.Text))), "MM/dd/yyyy") & "#"), DT, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = YULIAN
End Sub
Sub ISI_COMBO()
Dim I As Integer
For I = 1999 To 2020
cmbTahun1.AddItem I
cmbTahun2.AddItem I
Next
For I = 1 To 12
cmbBulan1.AddItem Format(DateSerial(2000, I, 1), "MMMM")
cmbBulan2.AddItem Format(DateSerial(2000, I, 1), "MMMM")
Next
cmbBulan1.Text = cmbBulan1.List(0)
cmbBulan2.Text = cmbBulan2.List(0)
cmbTahun1.Text = cmbTahun1.List(0)
cmbTahun2.Text = cmbTahun2.List(0)
End Sub
Function AkhirBulan(ByVal BLN As Integer) As Integer
Select Case BLN
Case 1: AkhirBulan = 31
Case 2: AkhirBulan = 28
Case 3: AkhirBulan = 31
Case 4: AkhirBulan = 30
Case 5: AkhirBulan = 31
Case 6: AkhirBulan = 30
Case 7: AkhirBulan = 31
Case 8: AkhirBulan = 31
Case 9: AkhirBulan = 30
Case 10: AkhirBulan = 31
Case 11: AkhirBulan = 30
Case 12: AkhirBulan = 31
End Select
End Function
Function NilaiBulan(ByVal BLN As String) As Integer
Select Case BLN
Case "Januari": NilaiBulan = 1
Case "Februari": NilaiBulan = 2
Case "Maret": NilaiBulan = 3
Case "April": NilaiBulan = 4
Case "Mei": NilaiBulan = 5
Case "Juni": NilaiBulan = 6
Case "Juli": NilaiBulan = 7
Case "Agustus": NilaiBulan = 8
Case "September": NilaiBulan = 9
Case "Oktober": NilaiBulan = 10
Case "Nopember": NilaiBulan = 11
Case "Desember": NilaiBulan = 12
End Select
End Function
'==========================================================================================================
Private Sub CboKet_Change()
TampilkanDatagrid
End Sub
Private Sub CboKet_Click()
TampilkanDatagrid
End Sub
Private Sub cmbBulan1_Click()
Call TampilkanDatagrid
End Sub
Private Sub cmbBulan2_Click()
Call TampilkanDatagrid
End Sub
Private Sub cmbTahun1_Click()
Call TampilkanDatagrid
End Sub
Private Sub cmbTahun2_Click()
Call TampilkanDatagrid
End Sub
Private Sub CmdPrint_Click()
If CboKet.Text = "" Then
MsgBox "Tentukan pilihan...!!!"
CboKet.SetFocus
Exit Sub
End If
Call HitungJumlahTagihan
With CRP
.ReportFileName = App.Path & "\p.rpt"
.WindowState = crptMaximized
.SelectionFormula = "{ado.Keterangan}='" & CboKet.Text & "' and{ado.Tanggal}>=Date (" & Val(cmbTahun1.Text) & "," & NilaiBulan(cmbBulan1.Text) & "," & 1 & ") " & " and {ado.Tanggal}<= Date(" & Val(cmbTahun2.Text) & "," & NilaiBulan(cmbBulan2.Text) & "," & AkhirBulan(NilaiBulan(cmbBulan2.Text)) & ")"
.Formulas(0) = "TOTALNYA='" & Terbilang(Str(JumlahTagihan)) & "'"
'.SelectionFormula = "{TRekening.NoLGN}'" & Combo1.Text & " and {TRekening.NoLGN}'" & Combo2.Text & "'"
'.SelectionFormula = "{TDTiket.Nip}='" & Nip.Text & "' and {TAbsen.TglAbsen}<= Date(" & Year(DTPicker3.Value) & "," & Month(DTPicker3.Value) & "," & Day(DTPicker3.Value) & ") "
.RetrieveDataFiles
.Action = 1 ' print report
End With
End Sub
'Private Sub Form_Activate()
'Call ISICOMBO
'End Sub
Private Sub Form_Load()
Call KONEKSI
Call ISI_COMBO
End Sub
'Private Sub ISICOMBO()
'If CboKet.Enabled = True Then
' DTCombo.RecordSource = "SELECT * FROM Tbl_KetLap ORDER BY Keterangan"
' DTCombo.Refresh
' With DTCombo.Recordset
' CboKet.Clear
' 'NmPegawai.Clear
' If .RecordCount <> 0 Then
' .MoveFirst
' Do Until .EOF
' CboKet.AddItem !Keterangan
' 'NmPegawai.AddItem !NmPegawai
' .MoveNext
' Loop
' End If
' End With
'End If
'End Sub
Public Function RKanan(NData, CFormat) As String
RKanan = Format(NData, CFormat)
RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan
End Function
Public Function Terbilang(strAngka As String) As String
Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$
Dim X, Y, z As Integer
If strAngka = "" Then Exit Function
strJmlHuruf = LTrim(strAngka)
intPecahan = Val(Right(Mid(strAngka, 15, 2), 2))
If (intPecahan = 0) Then
strPecahan = ""
Else
strPecahan = LTrim(Str(intPecahan)) + "10/100"
End If
X = 0
Y = 0
Urai = ""
While (X < Len(strJmlHuruf))
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
Y = Y + Val(strTot)
z = Len(strJmlHuruf) - X + 1
Select Case Val(strTot)
Case 1
If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then
Bil1 = "Satu "
ElseIf (z = 4) Then
If (X = 1) Then
Bil1 = "Se"
Else
Bil1 = "Satu "
End If
ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
X = X + 1
strTot = Mid(strJmlHuruf, X, 1)
z = Len(strJmlHuruf) - X + 1
Bil2 = ""
Select Case Val(strTot)
Case 0
Bil1 = "Sepuluh "
Case 1
Bil1 = "Sebelas "
Case 2
Bil1 = "Dua Belas "
Case 3
Bil1 = "Tiga Belas "
Case 4
Bil1 = "Empat Belas "
Case 5
Bil1 = "Lima Belas "
Case 6
Bil1 = "Enam Belas "
Case 7
Bil1 = "Tujuh Belas "
Case 8
Bil1 = "Delapan Belas "
Case 9
Bil1 = "Sembilan Belas "
End Select
Else
Bil1 = "Se"
End If
Case 2
Bil1 = "Dua "
Case 3
Bil1 = "Tiga "
Case 4
Bil1 = "Empat "
Case 5
Bil1 = "Lima "
Case 6
Bil1 = "Enam "
Case 7
Bil1 = "Tujuh "
Case 8
Bil1 = "Delapan "
Case 9
Bil1 = "Sembilan "
Case Else
Bil1 = ""
End Select
If (Val(strTot) > 0) Then
If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then
Bil2 = "Puluh "
ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then
Bil2 = "Ratus "
Else
Bil2 = ""
End If
Else
Bil2 = ""
End If
If (Y > 0) Then
Select Case z
Case 4
Bil2 = Bil2 + "Ribu "
Y = 0
Case 7
Bil2 = Bil2 + "Juta "
Y = 0
Case 10
Bil2 = Bil2 + "Milyar "
Y = 0
Case 13
Bil2 = Bil2 + "Trilyun "
Y = 0
End Select
End If
Urai = Urai + Bil1 + Bil2
Wend
Urai = Urai + strPecahan
Terbilang = Urai & " Rupiah"
End Function
Terima Kasih Kawan Semoga Artikel Cara Membuat Laporan Berdasarkan Kriteria dan Terbilang Vb 6.0 Bermanfaat buat teman teman.
Semoga Bermanfaat, jika ingin mengeshare di blog anda tolong sumber artikel di tulis di blog/website anda. Terima Kasih Salam RELAINC ANDRO
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 :
