Option Compare Database
Private Sub Form_Load()
Me.TxtTanggal1.Value = Date
Me.TxtTanggal2.Value = Date
Me.RecordSource = "SELECT * FROM t_beli WHERE tanggal>=#" & Me.TxtTanggal1.Value & "# AND tanggal<=#" & Me.TxtTanggal2.Value & "#"
End Sub
Private Sub TxtFilter_AfterUpdate()
If Me.TxtFilter.Value <> "" Then
DoCmd.ApplyFilter , "pembeli like '*" & Me.TxtFilter.Value & "*'"
Else
DoCmd.ApplyFilter , "no_nota<>''"
End If
End Sub
Private Sub TxtTanggal1_AfterUpdate()
Me.RecordSource = "SELECT * FROM t_jual WHERE tanggal>=#" & Me.TxtTanggal1.Value & "# AND tanggal<=#" & Me.TxtTanggal2.Value & "#"
End Sub
Private Sub TxtTanggal1_BeforeUpdate(Cancel As Integer)
If Not IsDate(Me.TxtTanggal1.Value) Then Cancel = 1
End Sub
Private Sub TxtTanggal2_AfterUpdate()
Me.RecordSource = "SELECT * FROM t_jual WHERE tanggal>=#" & Me.TxtTanggal1.Value & "# AND tanggal<=#" & Me.TxtTanggal2.Value & "#"
End Sub
Private Sub TxtTanggal2_BeforeUpdate(Cancel As Integer)
If Not IsDate(Me.TxtTanggal2.Value) Then Cancel = 1
End Sub
Form Module 1
Option Compare Database
Function BukaForm(strForm As String)
DoCmd.OpenForm strForm, acNormal
End Function
Function BukaReport(strReport As String)
DoCmd.OpenReport strReport, acViewReport
End Function
Form Beli Detail
Option Compare Database
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.no_nota.Value = Form_f_Beli.getNota
End Sub
Private Sub Form_Load()
End Sub
Private Sub kode_AfterUpdate()
Dim HargaJual As Currency
Dim rsBarang As Recordset
Set rsBarang = CurrentDb.OpenRecordset("SELECT * FROM t_barang WHERE kode='" & Me.kode.Value & "'")
If rsBarang.RecordCount = 0 Then
MsgBox "Kode barang tidak ditemukan, cek kembali", vbExclamation, "^_^ Not Found"
Else
Me.nama.Value = rsBarang!nama
Me.harga_beli.Value = rsBarang!harga_beli
Me.jumlah.SetFocus
End If
End Sub
Form Beli
Option Compare Database
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.no_nota.Value = Form_f_Beli.getNota
End Sub
Private Sub Form_Load()
End Sub
Private Sub kode_AfterUpdate()
Dim HargaJual As Currency
Dim rsBarang As Recordset
Set rsBarang = CurrentDb.OpenRecordset("SELECT * FROM t_barang WHERE kode='" & Me.kode.Value & "'")
If rsBarang.RecordCount = 0 Then
MsgBox "Kode barang tidak ditemukan, cek kembali", vbExclamation, "^_^ Not Found"
Else
Me.nama.Value = rsBarang!nama
Me.harga_beli.Value = rsBarang!harga_beli
Me.jumlah.SetFocus
End If
End Sub
Form Jual
Option Compare Database
Dim StrNota As String
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF9
Simpan
Case vbKeyEscape
Batal
End Select
End Sub
Sub Simpan()
On Error GoTo SimpanError
DoCmd.SetWarnings False
Me.total_harga.Value = Me.TxtTotHarga.Value
DoCmd.RunCommand acCmdSaveRecord
'mengurangi stok
Dim rsDetail As Recordset
Set rsDetail = CurrentDb.OpenRecordset("SELECT kode,jumlah FROM t_jual_detail WHERE no_nota='" & StrNota & "'")
If rsDetail.RecordCount > 0 Then
While Not rsDetail.EOF
DoCmd.RunSQL "UPDATE t_barang SET stok=stok-" & rsDetail!jumlah & " WHERE kode='" & rsDetail!kode & "'"
rsDetail.MoveNext
Wend
End If
Set rsDetail = Nothing
MsgBox "Data telah disimpan, Tekan OK untuk mencetak Nota", vbInformation, "^_^ Saved"
DoCmd.OpenReport "r_jual", acViewReport, , "no_nota='" & StrNota & "'"
NewNota
DoCmd.SetWarnings True
Exit Sub
SimpanError:
MsgBox "Terjadi kesalahan waktu menyimpan", vbCritical, "^_^ Error"
End Sub
Sub Batal()
On Error GoTo BatalError
If MsgBox("Nota ini belum disimpan, apakah mau dihapus??", vbQuestion + vbOKCancel, "^_^ Quit") = vbOK Then
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM t_jual WHERE no_nota='" & Me.no_nota.Value & "'"
DoCmd.SetWarnings True
DoCmd.Close acForm, "f_jual", acSaveYes
End If
Exit Sub
BatalError:
MsgBox "Dibatalkan", vbExclamation, "^_^ Canceled"
End Sub
Private Sub Form_Load()
NewNota
Me.tanggal.Value = Date
End Sub
Sub NewNota()
On Error Resume Next
DoCmd.GoToRecord , , acNewRec
Dim rsJual As Recordset
Set rsJual = CurrentDb.OpenRecordset("SELECT no_nota FROM t_jual WHERE tanggal=#" & Date & "# ORDER BY no_nota")
If rsJual.RecordCount = 0 Then
StrNota = "TJ" & Format(Date, "yyyyMMdd") & "001"
Else
rsJual.MoveLast
StrNota = "TJ" & Format(Date, "yyyyMMdd") & Right("00" & Trim(Str(Val(Right(rsJual!no_nota, 3)) + 1)), 3)
End If
Me.no_nota.Value = StrNota
End Sub
Function getNota() As String
getNota = StrNota
End Function
Private Sub FormHeader_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Label18.SpecialEffect = 4 Then
Me.Label18.BorderStyle = 0
Me.Label18.BorderWidth = 0
Me.Label18.SpecialEffect = 0
End If
If Me.LblTutup.SpecialEffect = 4 Then
Me.LblTutup.BorderStyle = 0
Me.LblTutup.BorderWidth = 0
Me.LblTutup.SpecialEffect = 0
End If
End Sub
Private Sub Label18_Click()
Form_KeyDown vbKeyF9, 0
End Sub
Private Sub Label18_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.Label18.SpecialEffect <> 4 Then
Me.Label18.BorderStyle = 1
Me.Label18.BorderWidth = 2
Me.Label18.SpecialEffect = 4
End If
End Sub
Private Sub LblTutup_Click()
Form_KeyDown vbKeyEscape, 0
End Sub
Private Sub LblTutup_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Me.LblTutup.SpecialEffect <> 4 Then
Me.LblTutup.BorderStyle = 1
Me.LblTutup.BorderWidth = 2
Me.LblTutup.SpecialEffect = 4
End If
End Sub
Private Sub Text12_AfterUpdate()
If Me.Text12.Value >= Me.TxtTotHarga.Value Then
Me.Label14.Caption = "Kembalian : "
Me.Text13.BackColor = vbWhite
Me.Text13.Value = Me.Text12.Value - Me.TxtTotHarga.Value
Me.total_bayar.Value = Me.TxtTotHarga.Value
Else
Me.Label14.Caption = "Kekurangan : "
Me.Text13.BackColor = vbRed
Me.Text13.Value = Me.TxtTotHarga.Value - Me.Text12.Value
Me.total_bayar.Value = Me.Text12.Value
End If
End Sub
0 comments:
Post a Comment