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

Untuk mengcapitalkan isi textbox

Sub CapitalTb()
Dim oText(100) As String
Dim i As Integer

    For Each obj In Me.Controls
        If Left(obj.Name, 3) = "txt" Then
            obj.Text = UCase(obj.Text)
            obj.Text = Replace(obj.Text, "'", "`")
        End If
    Next
          
End Sub

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

Vb Script - 2

Function HanyaAngka(ByRef KeyAscii As Integer)
    If ((KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57) Then
        MsgBox "Isilah dengan angka!", vbExclamation, App.Title
        KeyAscii = 0
    End If
End Function


Function HijriDate()
Dim xTgl As String
Dim xHijri As String
Dim days As DayConstants

    xTgl = Format(xLoginDate, "yyyy-mm-dd")
    days = Date - CDate(xTgl)
    days = days + 1
    DateTime.Calendar = vbCalHijri
    xHijri = Format(Date - days, "dd-mm-yyyy")
    xSistemHijriDate = xHijri
        If Mid(xHijri, 4, 2) = "01" Then xHijri = Replace(xHijri, "-01-", " Muharram ")
        If Mid(xHijri, 4, 2) = "02" Then xHijri = Replace(xHijri, "-02-", " Safar ")
        If Mid(xHijri, 4, 2) = "03" Then xHijri = Replace(xHijri, "-03-", " Rabiul Awal ")
        If Mid(xHijri, 4, 2) = "04" Then xHijri = Replace(xHijri, "-04-", " Rabiul Akhir ")
        If Mid(xHijri, 4, 2) = "05" Then xHijri = Replace(xHijri, "-05-", " Jumadal Ula ")
        If Mid(xHijri, 4, 2) = "06" Then xHijri = Replace(xHijri, "-06-", " Jumadal Tsani ")
        If Mid(xHijri, 4, 2) = "07" Then xHijri = Replace(xHijri, "-07-", " Rajab ")
        If Mid(xHijri, 4, 2) = "08" Then xHijri = Replace(xHijri, "-08-", " Sya'ban ")
        If Mid(xHijri, 4, 2) = "09" Then xHijri = Replace(xHijri, "-09-", " Ramadhan ")
        If Mid(xHijri, 4, 2) = "10" Then xHijri = Replace(xHijri, "-10-", " Syawwal ")
        If Mid(xHijri, 4, 2) = "11" Then xHijri = Replace(xHijri, "-11-", " Dzulkaidah ")
        If Mid(xHijri, 4, 2) = "12" Then xHijri = Replace(xHijri, "-12-", " Dzulhijjah ")
    xLoginHijri = xHijri
    DateTime.Calendar = vbCalGreg
   
End Function


Function CpuId() As String
Dim computer As String
Dim wmi As Variant
Dim processors As Variant
Dim cpu As Variant
Dim cpu_ids As String

    computer = "."
    Set wmi = GetObject("winmgmts:" & _
        "{impersonationLevel=impersonate}!\\" & _
        computer & "\root\cimv2")
    Set processors = wmi.ExecQuery("Select * from " & _
        "Win32_Processor")

    For Each cpu In processors
        cpu_ids = cpu_ids & ", " & cpu.ProcessorID
    Next cpu
    If Len(cpu_ids) > 0 Then cpu_ids = Mid$(cpu_ids, 3)

    CpuId = cpu_ids
End Function

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

VB Script - 1

Sub TreeALL()
Dim nodX As Node
Dim nodX2 As Node
Dim s As String
Dim i As Long
Dim xParent As Long
Dim xParent2 As Long
  
    nMenu = 0
    For Each obj In frmMain.Controls
        If Left(obj.Name, 2) = "mn" Then
            If Mid(obj.Name, 3, 1) = "0" Then menuName(nMenu) = Mid(obj.Name, 4, 10)
                If Mid(obj.Name, 3, 1) = "1" Then menuName(nMenu) = Mid(obj.Name, 3, 10)
                    menuCaption(nMenu) = Replace(obj.Caption, "&", "")
                    menuCaption(nMenu) = obj.Name & ". " & SplitText(menuCaption(nMenu), ".", 2)
                    menuCaption(nMenu) = Replace(menuCaption(nMenu), "mn", "")
                    nMenu = nMenu + 1
        End If
    Next
          
        For i = 0 To nMenu - 1
                If Len(menuName(i)) = 1 Then
                    xParent = Left(menuName(i), 1)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) = 2 Then
                    xParent = Left(menuName(i), 2)
                    Set nodX = treeview1.Nodes.Add(, , "mn" & xParent, menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                  
                ElseIf Len(menuName(i)) > 2 And Len(menuName(i)) < 5 Then
                    Set nodX = treeview1.Nodes.Add("mn" & xParent, tvwChild, , menuCaption(i))
                    nodX.Checked = False
                    nodX.Expanded = True
                       
                ElseIf Len(menuName(i)) = 5 Then
                    Set nodX2 = treeview1.Nodes.Add(nodX, tvwChild, , menuCaption(i))
                    nodX2.Checked = False
                    nodX2.Expanded = True
                End If
            Next
            treeview1.BorderStyle = vbFixedSingle
            Call TreeBold
          
End Sub
Sub TreeGroup()
Dim i As Integer
Dim j As Integer
Dim xMenuGroup As String
Dim xMenuMaster As String

    For i = 1 To Me.ListView1.ListItems.Count
        xMenuGroup = Me.ListView1.ListItems.Item(i).ListSubItems(2).Text
        For j = 1 To Me.treeview1.Nodes.Count
            xMenuMaster = SplitText(Me.treeview1.Nodes.Item(j).Text, ".", 1)
            If xMenuGroup = xMenuMaster Then Me.treeview1.Nodes.Item(j).Checked = True
        Next
    Next
  
End Sub
Sub TreeBold()
Dim i As Integer

    For i = 1 To Me.treeview1.Nodes.Count
        If Len(SplitText(Me.treeview1.Nodes(i).Text, ".", 1)) = 2 Then Me.treeview1.Nodes(i).Bold = True
    Next
  
End Sub

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