RSS

Report dengan Active report

Private Sub ActiveReport_ReportStart()
Dim strSql As String
Dim sql As String

    lblNamaBank.Caption = xLoginLembaga & " - " & xLoginCabang
    lblAlamatBank.Caption = xLoginCabangAlamat & " Telp. " & xLoginCabangTelp
  
    lblJudul.Caption = "NOMINATIF LAPORAN ANALISA KREDIT"
    lblPeriode.Caption = "Periode " & Format(frmReportAnalisa.dtAnalisa1.Value, "dd mmmm yyyy") & _
                         " s.d " & Format(frmReportAnalisa.dtAnalisa2.Value, "dd mmmm yyyy")
    lblDicetak.Caption = "Dicetak oleh " & xLoginNama & ", Tanggal " & Format(Now, "dd-mm-yyyy") & _
                         ", Jam " & Format(Now, "hh:mm:ss")
  
    With frmReportAnalisa
        If .txtKdKantor.Text <> "" Then _
            sql = sql & " AND pengajuan_kantor = '" & .txtKdKantor.Text & "'"
        If .txtKdSkim.Text <> "" Then _
            sql = sql & " AND analisa_jenis_skim = '" & .txtKdSkim.Text & "'"
        If .txtKdJenis.Text <> "" Then _
            sql = sql & " AND analisa_jenis_kredit = '" & .txtKdJenis.Text & "'"
        If .txtKdBunga.Text <> "" Then _
            sql = sql & " AND analisa_sistem_bunga = '" & .txtKdBunga.Text & "'"
        If .txtKdAngsuran.Text <> "" Then _
            sql = sql & " AND analisa_sistem_angsuran = '" & .txtKdAngsuran.Text & "'"
        If .txtKdCS.Text <> "" Then _
            sql = sql & " AND pengajuan_reg_alias = '" & SplitText(.cboCS.Text, ":", 2) & "'"
        If .txtKdKolektor.Text <> "" Then _
            sql = sql & " AND pelengkap_kode_kolektor = '" & .txtKdKolektor.Text & "'"
        If .txtKdAnalisa.Text <> "" Then _
            sql = sql & " AND kredit_metode = '" & .txtKdAnalisa.Text & "'"
        If .txtPlafon1.Text <> "0" And .txtPlafon2.Text <> "0" Then _
            sql = sql & " AND analisa_plafon BETWEEN " & CCur(.txtPlafon1.Text) & " AND " & CCur(.txtPlafon2.Text) & " "
    End With
  
    strSql = "SELECT pengajuan_regnumber, pengajuan_register, pengajuan_kantor, pengajuan_tanggal_registrasi, kredit_metode, " & _
            "kredit_skor_akhir, analisa_bunga, analisa_jkw, kredit_tgl_analisa, kredit_rekomendasi, " & _
            "analisa_jenis_kredit, analisa_plafon, pengajuan_reg_alias, analisa_sistem_bunga, pengajuan_tanggal_kunjungan, " & _
            "analisa_sistem_angsuran, analisa_jenis_skim, pelengkap_kode_avalis, pelengkap_kode_kolektor, kredit_regnumber, " & _
            "pelengkap_kode_wilayah, pelengkap_kode_wilayah2, pelengkap_notaris_kode, pelengkap_kode_avalis, " & _
            "GetNamaKolektor(pelengkap_kode_kolektor, left(pengajuan_regnumber, 2)) as NamaKolektor, " & _
            "GetSistemBunga(analisa_sistem_bunga) as SistemBunga, " & _
            "GetAnalisaMetode(kredit_metode) as MetodeAnalisa, " & _
            "GetSistemAngsuran(analisa_sistem_angsuran) as SistemAngsuran, " & _
            "GetNasabahNama(pengajuan_register) as NamaNasabah, " & _
            "GetAlamat(pengajuan_register) as AlamatNasabah " & _
            "FROM data_kredit_skor " & _
            "LEFT JOIN data_kredit_analisa ON analisa_regnumber = kredit_regnumber " & _
            "LEFT JOIN data_kredit_pengajuan ON pengajuan_regnumber = kredit_regnumber " & _
            "LEFT JOIN data_kredit_pelengkap ON pelengkap_rekening = kredit_regnumber " & _
            "WHERE 1 = 1 AND kredit_status = '1' AND (kredit_tgl_analisa " & _
            "BETWEEN '" & Format(frmReportAnalisa.dtAnalisa1.Value, "yyyy-mm-dd") & "' " & _
            "AND '" & Format(frmReportAnalisa.dtAnalisa2.Value, "yyyy-mm-dd") & "') " & sql
    RunSQL strSql
  
End Sub
Private Sub ActiveReport_FetchData(EOF As Boolean)
  
    On Error Resume Next
    If rsNew.EOF = True Then Exit Sub
        EOF = False
        Screen.MousePointer = 11
      
            lblNo.Caption = Val(lblNo.Caption) + 1
            lblNoPengajuan.Caption = rsNew.Fields("pengajuan_regnumber")
            lblNama.Caption = " " & rsNew.Fields("NamaNasabah")
            lblAlamat.Caption = " " & rsNew.Fields("AlamatNasabah")
            lblTglPengajuan.Caption = Format(rsNew.Fields("pengajuan_tanggal_registrasi"), "dd-mm-yyyy")
            lblTglAnalisa.Caption = Format(rsNew.Fields("kredit_tgl_analisa"), "dd-mm-yyyy")
            lblAnalisa.Caption = " " & rsNew.Fields("MetodeAnalisa")
            lblSkim.Caption = rsNew.Fields("analisa_jenis_skim")
            lblJenis.Caption = rsNew.Fields("analisa_jenis_kredit")
            lblSistemBunga.Caption = rsNew.Fields("SistemBunga")
            lblSistemAngsuran.Caption = rsNew.Fields("SistemAngsuran")
            lblPlafon.Caption = Format(rsNew.Fields("analisa_plafon"), "#,##0") & " "
                lblTotal.Caption = Val(Replace(lblTotal.Caption, ".", "")) + Val(Replace(lblPlafon.Caption, ".", ""))
                lblTotal.Caption = Format(lblTotal.Caption, "#,##0") & " "
            lblBunga.Caption = rsNew.Fields("analisa_bunga") & " %"
            lblJkw.Caption = rsNew.Fields("analisa_jkw")
            lblKolektor.Caption = rsNew.Fields("NamaKolektor")
            lblSkor.Caption = Replace(rsNew.Fields("kredit_skor_akhir"), ".", ",") & " % "
            lblKet.Caption = rsNew.Fields("kredit_rekomendasi")
                If lblKet.Caption = "TIDAK LAYAK" Then lblKet.Caption = "TIDAK"
              
        rsNew.MoveNext
        Screen.MousePointer = 0
      
      
End Sub

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Small Script

 'Front Critical
   If MsgBox("Apakah yakin akan menghapus : " & xxx & "", _
        vbCritical + vbYesNo, Me.Caption) = vbYes Then 


'Call proccedure
    dB.Execute "CALL `db`.`procedure_name('" & xIdKredit & "')

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Export ke excel

       ' EXPORT TO EXCEL

            If ListView1.ListItems.Count = 0 Then
                MsgBox "Tidak ada data!", vbExclamation, App.Title
                exit sub
            End If
       
        XLSFILENAME = ""
        With Me.cd1
            .Filter = "Excel Workbook (.xls)"
            .ShowSave
        XLSFILENAME = .filename
        End With
      
        If XLSFILENAME = "" Then
        Exit Sub
        End If
      
        Call ExportListview(ListView1, XLSFILENAME)
            MsgBox "Export sukses!", vbInformation, App.Title
        XLSFILENAME = ""

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS

Multiline Label

Label1.Caption = "Hello AN," & vbCrLf & "This is Bob."

  • Digg
  • Del.icio.us
  • StumbleUpon
  • Reddit
  • RSS