Jumat, 10 Februari 2012

Membuat No Faktur

Membuat No Faktur


Karena ada permintaan dari teman, maka di edisi ini, saya buat artikel tentang membuat no urut pada faktur secara otomatis, namun pada saat ganti bulan maka no urut tersebut kembali ke no awal, berikut ini contohnya. Silahkan design sebuah form seperti gambar dibawah ini :


Dim conn As New Connection
Dim rs As New Recordset
Dim rsFinder As New Recordset
Dim sql As String
Dim NoUrut As String
Dim bulanOld As Byte
Dim bulanNew As Byte
Dim cekNo As String
Dim AmbilNo As String
Dim Panjang As String
Dim NoUrutan As String


Private Sub Form_Load()
  conn.Provider = "Microsoft.Jet.OLEDB.4.0"
  conn.Open App.Path & "\nwind.mdb"
 
  rs.CursorLocation = adUseClient
 
  sql = "SELECT * FROM tbl_nourut ORDER BY id"
  rs.Open sql, conn, adOpenDynamic, adLockOptimistic
  DTPicker1.Value = Now
End Sub

Private Sub cmdNewRecord_Click()
  '---standar no urut yg digunakan
  NoUrut = "Faktur/Per-XXX/" & Format(Now, "ddmmyyyy")

  '---apabila id nya masih kosong maka buat nourut
  '---sesuai standard contohnya Faktur/Per-XXX/26022009-00001
  If rs.RecordCount = 0 Then
    Text1.Text = NoUrut & "-" & "00001"
  Else
    rs.MoveLast
    bulanOld = Format(rs("tgl"), "m")
    bulanNew = Format(Now, "m")
 
 
  '---jika bulanOld nilainya lbh kecil dari bulanNew
  '---berati udah ganti bulan
     If bulanOld < bulanNew Then
        '---periksa no urut, sudah ada atau blm
        cekNo = NoUrut & "-" & "00001"
        sql = "SELECT no_urut FROM tbl_nourut " & _
        "WHERE no_urut= '" & cekNo & "'"
        rsFinder.CursorLocation = adUseClient
        rsFinder.Open sql, conn
 
        If rsFinder.RecordCount = 0 Then
           '--buat no urut dari awal sesuai bulan berjalan
           Text1.Text = NoUrut & "-" & "00001"
           rsFinder.Close
           Exit Sub
        End If
     End If
 
  '---ambil karakter dari kanan pada field no_urut
  AmbilNo = Right(rs("no_urut"), 5)
 
  '---dari 5 karakter itu, tambahkan dgn angka 1
  '---misalnya nilainya 00001 maka variabel ini
  '---akan terisi dgn nilai 2
  Panjang = AmbilNo + 1
 
  '---cek panjang dari hasil penjumlahan diatas
  Select Case Len(Panjang)
  Case 1: NoUrutan = "0000" & Panjang
  Case 2: NoUrutan = "000" & Panjang
  Case 3: NoUrutan = "00" & Panjang
  Case 4: NoUrutan = "0" & Panjang
  Case 5: NoUrutan = Panjang
  End Select
 
  Text1.Text = NoUrut & "-" & NoUrutan
  End If
  Set rsFinder = Nothing
End Sub

Private Sub cmdSaveRecord_Click()
  rs.AddNew
  rs("no_urut") = Text1.Text
  rs("tgl") = DTPicker1.Value
  rs.Update
  rs.Requery
End Sub

Tidak ada komentar: