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:
Posting Komentar