=============================================================
Nomor Urut Berdasarkan Bulan dan Hari
=============================================================
Dim Mnotrans As String
Dim mNourut, Mbulan, Mday As String
Mbulan = CStr(Month(Now))
Mday = CStr(Day(Now))
Mday = IIf(Len(Mday) = 1, "0" + Mday, Mday)
Mnotrans = CStr(Year(Now)) + IIf(Len(Mbulan) = 1, "0" + Mbulan, Mbulan) + Mday
Set RsCari = New ADODB.Recordset
If RsCari.State = adStateOpen Then RsCari.Close
RsCari.Open "select * from tbangsuran where notrans like '" & Mnotrans & "%' order by notrans", Conn, adOpenKeyset, adLockOptimistic
If RsCari.RecordCount > 0 Then
RsCari.MoveLast
mNourut = CStr(Val(Right(RsCari!Notrans, 4)) + 1)
Mnotrans = Mnotrans + IIf(Len(mNourut) = 1, "000" + mNourut, "" _
& IIf(Len(mNourut) = 2, "00" + mNourut, IIf(Len(mNourut) = 3, "0" + mNourut, mNourut)))
Else
Mnotrans = Mnotrans + MUtama.MKode + "01"
End If
TxtNoTrans.Text = Mnotrans
TxtNoRek.SetFocus
==============================================================
Nomor Urut Berdasarkan Kode
==============================================================
Dim MBKd As String
Dim MNoUrut As String
Dim MOpen As ADODB.Recordset
Dim SQLCari As String
Set MOpen = New ADODB.Recordset
If MOpen.State = adStateOpen Then MOpen.Close
MOpen.Open "select * from tbjenis where kddept='" & TxtBKd.Text & "' order by kddept", Conn, adOpenKeyset, adLockOptimistic
MBKd = MOpen!kddept + "."
'MsgBox MBKd
MNoUrut = MBKd
Set RsCari = New ADODB.Recordset
If RsCari.State = adStateOpen Then RsCari.Close
RsCari.Open "select * from tbbrg where Bkd like '" & TxtBKd.Text & "%' order by BKd", Conn, adOpenKeyset, adLockOptimistic
If RsCari.RecordCount > 0 Then
RsCari.MoveLast
MNoUrut = CStr(Val(Right(RsCari!bkd, 4)) + 1)
MBKd = MBKd + IIf(Len(MNoUrut) = 1, "000" + MNoUrut, "" _
& IIf(Len(MNoUrut) = 2, "00" + MNoUrut, IIf(Len(MNoUrut) = 3, "0" + MNoUrut, MNoUrut)))
ElseIf RsCari.RecordCount = 1 Then
MsgBox "Kode Barang sudah ada!!!"
TxtBKd.SetFocus
Else
MBKd = MBKd + "0001"
End If
TxtBKd.Text = MBKd