Cara Membuat Laporan Berdasarkan Kriteria dan Terbilang Vb 6.0

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.

MEMBUAT LAPORAN BERDASARKAN KRITERIA DAN TERBILANG VB 6.0
Contoh Laporan berdasarkan Kriteria -Relainc Andro-

Yaitu Sebagi berikut untuk Gambaran Source Codenya :
Dim DT As ADODB.Connection
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
Jika ingin Mendownload Source Codenya bisa Download Disini. atau di Bawah ini.


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
Previous
Next Post »
Post a Comment
Thanks for your comment