LISTING PROGRAM. Private Sub MnCariHapus_Click() FrmEditHapusPembelian.Show vbmodal End Sub

LISTING PROGRAM

1.

FORM UTAMA Private Sub MnCariHapus_Click() FrmEditHapusPembelian.Show vbModal End Sub Private Sub MnCariHapusPenjualan_Click() FrmCariHapusJual.Show vbModal End Sub Private Sub MnKeluar_Click() End End Sub Private Sub MnKosong_Click() KOSONG.ReportFileName = App.Path & "\form\LapStokKosong.rpt" KOSONG.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" KOSONG.RetrieveDataFiles KOSONG.SelectionFormula = "{barang.jumlah}=0 " KOSONG.WindowState = crptMaximized KOSONG.DiscardSavedData = True KOSONG.Action = 1 End Sub Private Sub MnLaporanBarangStokAkhir_Click() Cr.ReportFileName = App.Path & "\form\lapbarang.rpt" Cr.DataFiles(0) = App.Path & "\form\barang.mdb" Cr.WindowState = crptMaximized Cr.Action = 1 End Sub Private Sub MnLaporanBeliBulanan_Click() FrmCetakBeli.Tgl.Enabled = False FrmCetakBeli.Tgl.CalendarBackColor = &HE0E0E0 FrmCetakBeli.Show vbModal

Universitas Sumatera Utara

End Sub Private Sub MnLaporanBeliHarian_Click() FrmCetakBeli.Bln.Enabled = False FrmCetakBeli.Bln.BackColor = &HE0E0E0 FrmCetakBeli.thn.Enabled = False FrmCetakBeli.thn.BackColor = &HE0E0E0 FrmCetakBeli.Show vbModal End Sub Private Sub MnLaporanBeliTahunan_Click() FrmCetakBeli.Tgl.Enabled = False FrmCetakBeli.Tgl.CalendarBackColor = &HE0E0E0 FrmCetakBeli.Bln.Enabled = False FrmCetakBeli.Bln.BackColor = &HE0E0E0 FrmCetakBeli.Show vbModal End Sub Private Sub MnLaporanPenjualanBulanan_Click() FrmCetakJual.Tgl.Enabled = False FrmCetakJual.Tgl.CalendarBackColor = &HE0E0E0 FrmCetakJual.Show vbModal End Sub Private Sub MnLaporanPenjualanHarian_Click() FrmCetakJual.Bln.Enabled = False FrmCetakJual.Bln.BackColor = &HE0E0E0 FrmCetakJual.thn.Enabled = False FrmCetakJual.thn.BackColor = &HE0E0E0 FrmCetakJual.Show vbModal End Sub Private Sub MnLaporanPenjualanTahunan_Click() FrmCetakJual.Tgl.Enabled = False FrmCetakJual.Tgl.CalendarBackColor = &HE0E0E0 FrmCetakJual.Bln.Enabled = False FrmCetakJual.Bln.BackColor = &HE0E0E0 FrmCetakJual.Show vbModal End Sub Private Sub MnPembelian_Click()


FrmPembelian.Show vbModal End Sub Private Sub MnPenjualan_Click() FrmPenjualan.Show vbModal End Sub Private Sub MnReturPenjualan_Click() FrmReturPenjualan.Show vbModal End Sub Private Sub MnStokBarang_Click() FrmBarang.Show vbModal End Sub Private Sub MnUtility1_Click() FrmTentangProgram.Show vbModal End Sub Private Sub MnUtility2_Click() FrmPerancang.Show vbModal End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) Select Case Button.Key Case "A" FrmBarang.Show vbModal Case "B" FrmPembelian.Show vbModal Case "C" FrmPenjualan.Show vbModal Case "D" FrmReturPenjualan.Show vbModal Case Else End End Select End Sub

2. FORM DATA BARANG


Private Sub cmdhapus_Click() X = TBLBARANG.Recordset!KODE TBLPEMBELIAN.Recordset.MoveFirst TBLPEMBELIAN.Recordset.Find "kode='" & X & "'" If TBLPEMBELIAN.Recordset.EOF Then TBLPENJUALAN.Recordset.MoveFirst TBLPENJUALAN.Recordset.Find "kodeBARANG='" & X & "'" If TBLPENJUALAN.Recordset.EOF Then pesan = MsgBox(" Benar Data akan dihapus", vbQuestion + vbYesNo, "Warning") If pesan = vbYes Then TBLBARANG.Recordset.Delete TBLBARANG.Recordset.Update End If Else MsgBox "Masih ada transaksi penjualan barang" Exit Sub End If Else MsgBox "Masih ada transaksi pembelian barang" Exit Sub End If End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Command3_Click() Form_Activate End Sub Private Sub DataGrid1_Click() CmdHapus.Enabled = True End Sub Private Sub EHARGABELI_KeyDown(KeyCode As Integer, Shift As Integer)


If KeyCode = 13 Then EHARGAJUAL.SetFocus ENAMABARANG.SelLength = Len(ENAMABARANG.Text) End If End Sub Private Sub EHARGAJUAL_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then EJUMLAHBARANG.SetFocus EJUMLAHBARANG.SelLength = Len(EJUMLAHBARANG.Text) End If End Sub Private Sub EJUMLAHBARANG_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then SIMPAN.Enabled = True SIMPAN.SetFocus End If End Sub Private Sub EKODEBARANG_KeyDown(KeyCode As Integer, Shift As Integer) 'On Error Resume Next If KeyCode = 13 Then TBLBARANG.Recordset.MoveFirst TBLBARANG.Recordset.Find "kode='" & EKODEBARANG.Text & "'" If TBLBARANG.Recordset.EOF Then MsgBox ("Kode barang tidak ditemukan") EKODEBARANG.SetFocus EKODEBARANG.SelLength = Len(EKODEBARANG.Text) Else ENAMABARANG.Text = TBLBARANG.Recordset!NAMABARANG EHARGABELI.Text = TBLBARANG.Recordset!HARGABELI EHARGAJUAL.Text = TBLBARANG.Recordset!HARGAJUAL EJUMLAHBARANG.Text = TBLBARANG.Recordset!JUMLAH ENAMABARANG.SetFocus ENAMABARANG.SelLength = Len(ENAMABARANG.Text) Me.Caption = TBLBARANG.Recordset.AbsolutePosition End If End If


End Sub Private Sub ENAMABARANG_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then EHARGABELI.SetFocus EHARGABELI.SelLength = Len(EHARGABELI.Text) End If End Sub Private Sub Form_Activate() TBLBARANG.CommandType = adCmdTable TBLBARANG.RecordSource = "BARANG" TBLBARANG.CursorLocation = adUseClient TBLBARANG.CursorType = adOpenDynamic TBLBARANG.Refresh Set DataGrid1.DataSource = TBLBARANG.Recordset KOSONG CmdHapus.Enabled = False DataGrid1.MarqueeStyle = 3 aturgrid EKODEBARANG.SetFocus End Sub Private Sub Form_Load() TBLBARANG.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLBARANG.CommandType = adCmdTable TBLBARANG.RecordSource = "BARANG" TBLBARANG.Refresh TBLPEMBELIAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLPEMBELIAN.CommandType = adCmdTable TBLPEMBELIAN.RecordSource = "PEMBELIAN" TBLPEMBELIAN.Refresh TBLPENJUALAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False"


TBLPENJUALAN.CommandType = adCmdTable TBLPENJUALAN.RecordSource = "PENJUALAN" TBLPENJUALAN.Refresh End Sub Private Sub KODEBARANG_Change() On Error Resume Next TBLBARANG.CommandType = adCmdText TBLBARANG.RecordSource = "select * from BARANG where KODE Like '%" & KODEBARANG.Text & "%'" TBLBARANG.Refresh Set DataGrid1.DataSource = TBLBARANG.Recordset aturgrid End Sub Private Sub NAMABARANG_Change() On Error Resume Next TBLBARANG.RecordSource = "select * from BARANG where NAMABARANG Like '%" + NAMABARANG.Text + "%'" TBLBARANG.CommandType = adCmdText TBLBARANG.Refresh Set DataGrid1.DataSource = TBLBARANG.Recordset aturgrid End Sub Sub KOSONG() EKODEBARANG.Text = Empty ENAMABARANG.Text = Empty EHARGABELI.Text = Empty EHARGAJUAL.Text = Empty EJUMLAHBARANG.Text = Empty End Sub Private Sub SIMPAN_Click() With TBLBARANG .Recordset!KODE = EKODEBARANG.Text .Recordset!NAMABARANG = ENAMABARANG.Text .Recordset!HARGABELI = EHARGABELI.Text .Recordset!HARGAJUAL = EHARGAJUAL.Text .Recordset!JUMLAH = EJUMLAHBARANG.Text


.Recordset.Update .Recordset.Requery DataGrid1.Refresh End With Form_Activate End Sub Sub aturgrid() DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False DataGrid1.AllowArrows = True DataGrid1.Columns(0).Caption = "KODE" DataGrid1.Columns(1).Caption = "NAMA BARANG" DataGrid1.Columns(1).Width = 8100 DataGrid1.Columns(2).Caption = "HARGA BELI" DataGrid1.Columns(2).Alignment = dbgRight DataGrid1.Columns(2).Width = 2000 DataGrid1.Columns(3).Caption = "HARGA JUAL" DataGrid1.Columns(3).Alignment = dbgRight DataGrid1.Columns(3).Width = 2000 DataGrid1.Columns(4).Caption = "JUMLAH" DataGrid1.Columns(4).Alignment = dbgRight DataGrid1.Columns(4).Width = 1400 End Sub

3. FORM CARI HAPUS JUAL BARANG

Private Sub cmdhapus_Click() On Error GoTo pesan


tanya = MsgBox("Apakah data akan dihapus ?", vbQuestion + vbYesNo, "Pertanyaan") If tanya = vbYes Then TblPenjualan.Recordset.Delete TblPenjualan.Refresh DataGrid1.Refresh End If KOSONG aturgrid cmdhapus.Enabled = False pesan: Exit Sub End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Command3_Click() Form_Activate End Sub

Private Sub EHARGABELI_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then EHARGAJUAL.SetFocus ENAMABARANG.SelLength = Len(ENAMABARANG.Text) End If End Sub Private Sub EHARGAJUAL_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then EJUMLAHBARANG.SetFocus EJUMLAHBARANG.SelLength = Len(EJUMLAHBARANG.Text) End If End Sub Private Sub EJUMLAHBARANG_KeyDown(KeyCode As Integer, Shift As Integer)


If KeyCode = 13 Then SIMPAN.Enabled = True SIMPAN.SetFocus End If End Sub Private Sub EKODEBARANG_KeyDown(KeyCode As Integer, Shift As Integer) 'On Error Resume Next If KeyCode = 13 Then TblPenjualan.Recordset.MoveFirst TblPenjualan.Recordset.Find "kode='" & EKODEBARANG.Text & "'" If TblPenjualan.Recordset.EOF Then MsgBox ("Kode barang tidak ditemukan") EKODEBARANG.SetFocus EKODEBARANG.SelLength = Len(EKODEBARANG.Text) Else ENAMABARANG.Text = TblPenjualan.Recordset!NAMABARANG EHARGABELI.Text = TblPenjualan.Recordset!HARGABELI EHARGAJUAL.Text = TblPenjualan.Recordset!HARGAJUAL EJUMLAHBARANG.Text = TblPenjualan.Recordset!JUMLAH ENAMABARANG.SetFocus ENAMABARANG.SelLength = Len(ENAMABARANG.Text) Me.Caption = TblPenjualan.Recordset.AbsolutePosition End If End If End Sub Private Sub ENAMABARANG_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then EHARGABELI.SetFocus EHARGABELI.SelLength = Len(EHARGABELI.Text) End If End Sub Private Sub DataGrid1_Click() cmdhapus.Enabled = True End Sub


Private Sub Form_Activate() TblPenjualan.CommandType = adCmdTable TblPenjualan.RecordSource = "PENJUALAN" TblPenjualan.CursorLocation = adUseClient TblPenjualan.CursorType = adOpenDynamic TblPenjualan.Refresh Set DataGrid1.DataSource = TblPenjualan.Recordset DataGrid1.MarqueeStyle = 3 KOSONG aturgrid DataGrid1.MarqueeStyle = 3 cmdhapus.Enabled = False End Sub Private Sub Form_Load() TblPenjualan.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TblPenjualan.CommandType = adCmdTable TblPenjualan.RecordSource = "PENJUALAN" TblPenjualan.Refresh End Sub Private Sub KODEBARANG_Change() On Error Resume Next TblPenjualan.CommandType = adCmdText TblPenjualan.RecordSource = "select * from PENJUALAN where KODEBARANG Like '%" & KODEBARANG.Text & "%'" TblPenjualan.Refresh Set DataGrid1.DataSource = TblPenjualan.Recordset aturgrid End Sub Sub KOSONG() End Sub Private Sub nofaktur_Change() On Error Resume Next TblPenjualan.CommandType = adCmdText


TblPenjualan.RecordSource = "select * from PENJUALAN where nomorfaktur Like '%" & nofaktur.Text & "%'" TblPenjualan.Refresh Set DataGrid1.DataSource = TblPenjualan.Recordset aturgrid End Sub Private Sub SIMPAN_Click() WithTBLPENJUALAN .Recordset!KODE = EKODEBARANG.Text .Recordset!NAMABARANG = ENAMABARANG.Text .Recordset!HARGABELI = EHARGABELI.Text .Recordset!HARGAJUAL = EHARGAJUAL.Text .Recordset!JUMLAH = EJUMLAHBARANG.Text .Recordset.Update .Recordset.Requery DataGrid1.Refresh End With Form_Activate End Sub Sub aturgrid() DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False DataGrid1.AllowArrows = True DataGrid1.Columns(0).Caption = "TGL" DataGrid1.Columns(0).Width = 1000

DataGrid1.Columns(1).Caption = "FAKTUR" DataGrid1.Columns(1).Width = 1200 DataGrid1.Columns(2).Caption = "PEMBELI" DataGrid1.Columns(2).Width = 2000 DataGrid1.Columns(3).Caption = "ALAMAT" DataGrid1.Columns(3).Width = 8000


DataGrid1.Columns(4).Caption = "KODE" DataGrid1.Columns(4).Width = 1000 DataGrid1.Columns(5).Caption = "NAMA BARANG" DataGrid1.Columns(5).Width = 8000 DataGrid1.Columns(6).Caption = "HARGA" DataGrid1.Columns(6).Alignment = dbgRight DataGrid1.Columns(6).Width = 1400 DataGrid1.Columns(7).Caption = "JUMLAH" DataGrid1.Columns(7).Alignment = dbgRight DataGrid1.Columns(7).Width = 1400 End Sub

4. FORM CETAK BELI Sub aktif(X As Boolean) Tgl.Enabled = X Bln.Enabled = X thn.Enabled = X End Sub Sub WARNA(belakang As String) Tgl.CalendarBackColor = KEADAAN Bln.BackColor = KEADAAN thn.BackColor = KEADAAN End Sub Private Sub Form_Activate() Tgl.Format = dtpShortDate thn.Text = Year(Date) End Sub Private Sub Preview_Click() If Tgl.Enabled = True Then


Cr3.ReportFileName = App.Path & "\form\LapBeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "{pembelian.Tglpembelian}=#" & Format(Tgl.Value, "MM/DD/YYYY") & "#" Cr3.WindowState = crptMaximized Cr3.DiscardSavedData = True Cr3.Action = 1 ElseIf Bln.Enabled = True Then Cr3.ReportFileName = App.Path & "\form\LapBeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "MONTH({pembelian.tglpembelian})=" & Val(Bln.Text) & " AND YEAR({pembelian.tglpembelian})=" & Val(thn.Text) Cr3.WindowState = crptMaximized Cr3.DiscardSavedData = True Cr3.Action = 1 Else Cr3.ReportFileName = App.Path & "\form\LapbeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "YEAR({pembelian.tglpembelian})=" & Val(thn.Text) Cr3.WindowState = crptMaximized Cr3.DiscardSavedData = True Cr3.Action = 1 End If End Sub Private Sub Printer_Click() If Tgl.Enabled = True Then Cr3.ReportFileName = App.Path & "\form\LapBeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "{pembelian.tglpembelian}=#" & Format(Tgl.Value, "MM/DD/YYYY") & "#" Cr3.Destination = crptToPrinter Cr3.DiscardSavedData = True Cr3.Action = 1 ElseIf Bln.Enabled = True Then


Cr3.ReportFileName = App.Path & "\form\LapBeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "MONTH({pembelian.tglpembelian})=" & Val(Bln.Text) & " AND YEAR({pembelian.tglpembelian})=" & Val(thn.Text) Cr3.Destination = crptToPrinter Cr3.DiscardSavedData = True Cr3.Action = 1 Else Cr3.ReportFileName = App.Path & "\form\LapBeliHarian.rpt" Cr3.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr3.RetrieveDataFiles Cr3.SelectionFormula = "YEAR({pembelian.tglpembelian})=" & Val(thn.Text) Cr3.Destination = crptToPrinter Cr3.DiscardSavedData = True Cr3.Action = 1 End If End Sub

5. FORM CETAK JUAL Sub aktif(X As Boolean) Tgl.Enabled = X Bln.Enabled = X thn.Enabled = X End Sub Sub WARNA(belakang As String) Tgl.CalendarBackColor = KEADAAN Bln.BackColor = KEADAAN thn.BackColor = KEADAAN End Sub Private Sub Form_Activate() Tgl.Format = dtpShortDate thn.Text = Year(Date) End Sub


Private Sub Preview_Click() If Tgl.Enabled = True Then Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "{penjualan.TglJual}=#" & Format(Tgl.Value, "MM/DD/YYYY") & "#" Cr2.WindowState = crptMaximized Cr2.DiscardSavedData = True Cr2.Action = 1 ElseIf Bln.Enabled = True Then Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "MONTH({penjualan.TglJual})=" & Val(Bln.Text) & " AND YEAR({penjualan.TglJual})=" & Val(thn.Text) Cr2.WindowState = crptMaximized Cr2.DiscardSavedData = True Cr2.Action = 1 Else Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "YEAR({penjualan.TglJual})=" & Val(thn.Text) Cr2.WindowState = crptMaximized Cr2.DiscardSavedData = True Cr2.Action = 1 End If End Sub Private Sub Printer_Click() If Tgl.Enabled = True Then Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "{penjualan.TglJual}=#" & Format(Tgl.Value, "MM/DD/YYYY") & "#" Cr.Destination = crptToPrinter Cr2.DiscardSavedData = True Cr2.Action = 1


ElseIf Bln.Enabled = True Then Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "MONTH({penjualan.TglJual})=" & Val(Bln.Text) & " AND YEAR({penjualan.TglJual})=" & Val(thn.Text) Cr.Destination = crptToPrinter Cr2.DiscardSavedData = True Cr2.Action = 1 Else Cr2.ReportFileName = App.Path & "\form\LapJualHarian.rpt" Cr2.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" Cr2.RetrieveDataFiles Cr2.SelectionFormula = "YEAR({penjualan.TglJual})=" & Val(thn.Text) Cr.Destination = crptToPrinter Cr2.DiscardSavedData = True Cr2.Action = 1 End If End Sub

6. FORM EDIT HAPUS PEMBELIAN

Private Sub DataGrid1_Click() HAPUS.Enabled = True End Sub Private Sub Form_Activate() TBLPEMBELIAN.CommandType = adCmdTable TBLPEMBELIAN.RecordSource = "PEMBELIAN" TBLPEMBELIAN.CursorLocation = adUseClient TBLPEMBELIAN.CursorType = adOpenDynamic TBLPEMBELIAN.Refresh Set DataGrid1.DataSource = TBLPEMBELIAN.Recordset KOSONG aturgrid NOMORFAKTUR.SetFocus DataGrid1.MarqueeStyle = 3


HAPUS.Enabled = False End Sub Private Sub Form_Load() TBLPEMBELIAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLPEMBELIAN.CommandType = adCmdTable TBLPEMBELIAN.RecordSource = "PEMBELIAN" TBLPEMBELIAN.Refresh End Sub Private Sub HAPUS_Click() On Error GoTo pesan tanya = MsgBox("Apakah data akan dihapus ?", vbQuestion + vbYesNo, "Pertanyaan") If tanya = vbYes Then TBLPEMBELIAN.Recordset.Delete TBLPEMBELIAN.Refresh DataGrid1.Refresh End If KOSONG aturgrid HAPUS.Enabled = False pesan: Exit Sub End Sub Private Sub KELUAR_Click() Unload Me End Sub Private Sub KODEBARANG_Change() 'On Error Resume Next TBLPEMBELIAN.CommandType = adCmdText TBLPEMBELIAN.RecordSource = "select * from PEMBELIAN where KODE Like '%" & KODEBARANG.Text & "%'" TBLPEMBELIAN.Refresh Set DataGrid1.DataSource = TBLPEMBELIAN.Recordset


aturgrid End Sub Private Sub NAMABARANG_Change() 'On Error Resume Next TBLPEMBELIAN.CommandType = adCmdText TBLPEMBELIAN.RecordSource = "select * from PEMBELIAN where NAMABARANG Like '%" & NAMABARANG.Text & "%'" TBLPEMBELIAN.Refresh Set DataGrid1.DataSource = TBLPEMBELIAN.Recordset aturgrid End Sub Private Sub NOMORFAKTUR_Change() On Error Resume Next TBLPEMBELIAN.CommandType = adCmdText TBLPEMBELIAN.RecordSource = "select * from PEMBELIAN where NOFAKTURBELI Like '%" & NOMORFAKTUR.Text & "%'" TBLPEMBELIAN.Refresh Set DataGrid1.DataSource = TBLPEMBELIAN.Recordset aturgrid End Sub Sub KOSONG() NOMORFAKTUR.Text = Empty KODEBARANG.Text = Empty NAMABARANG.Text = Empty End Sub Sub aturgrid() DataGrid1.AllowAddNew = False DataGrid1.AllowDelete = False DataGrid1.AllowUpdate = False DataGrid1.AllowArrows = True DataGrid1.Columns(0).Caption = "TGL BELI" DataGrid1.Columns(0).Width = 1500 DataGrid1.Columns(0).NumberFormat = "DD-MM-YYYY"


DataGrid1.Columns(1).Caption = "NO FAK" DataGrid1.Columns(1).Width = 1200 DataGrid1.Columns(2).Caption = "KODE" DataGrid1.Columns(2).Width = 1000 DataGrid1.Columns(3).Caption = "NAMA BARANG" DataGrid1.Columns(3).Width = 8000 DataGrid1.Columns(4).Caption = "BELI" DataGrid1.Columns(4).Width = 1400 DataGrid1.Columns(4).Alignment = dbgRight DataGrid1.Columns(5).Caption = "JUAL" DataGrid1.Columns(5).Width = 1400 DataGrid1.Columns(5).Alignment = dbgRight DataGrid1.Columns(6).Caption = "JUMLAH" DataGrid1.Columns(6).Width = 1400 DataGrid1.Columns(6).Alignment = dbgRight End Sub

7. FORM PEMBELIAN

Private Sub BATAL_Click() Form_Activate End Sub Private Sub CARI_Click() FrmEditHapusPembelian.Show vbModal End Sub Private Sub Form_Activate() KOSONG Call WARNA(&HE0E0E0) aktif (False)


TANGGALBELI.Text = Format(Date, "dd-mm-yyyy") NOFAKTURBELI.BackColor = vbWhite NOFAKTURBELI.Enabled = True NOFAKTURBELI.SetFocus TANGGALBELI.Enabled = False SIMPAN.Enabled = False End Sub Private Sub Form_Load() TBLBARANG.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLBARANG.CommandType = adCmdTable TBLBARANG.RecordSource = "BARANG" TBLBARANG.Refresh TBLPEMBELIAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLPEMBELIAN.CommandType = adCmdTable TBLPEMBELIAN.RecordSource = "PEMBELIAN" TBLPEMBELIAN.Refresh End Sub Private Sub HAPUS_Click() FrmEditHapusPembelian.Show vbModal End Sub Private Sub HARGABELI_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then HARGAJUAL.Enabled = True HARGAJUAL.BackColor = vbWhite HARGAJUAL.SetFocus HARGAJUAL.SelLength = Len(HARGAJUAL.Text) End If End Sub Private Sub HARGABELI_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then


KeyAscii = 0 End If End Sub Private Sub HARGAJUAL_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If Val(HARGABELI.Text) > Val(HARGAJUAL.Text) Then MsgBox " Harga penjualan harus lebih tinggi dari harga pembelian" HARGAJUAL.Text = Empty Exit Sub Else JUMLAHBELI.Enabled = True JUMLAHBELI.BackColor = vbWhite JUMLAHBELI.SetFocus JUMLAHBELI.SelLength = Len(JUMLAHBELI.Text) End If End If End Sub Private Sub HARGAJUAL_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then KeyAscii = 0 End If End Sub Private Sub JUMLAHBELI_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If JUMLAHBELI.Text = Empty Then MsgBox " Jumlah Beli masih kosong" Exit Sub End If SIMPAN.Enabled = True SIMPAN.SetFocus End If End Sub Private Sub JUMLAHBELI_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc(0) And KeyAscii <= Asc(9) Or KeyAscii = vbKeyBack) Then


KeyAscii = 0 End If End Sub Private Sub KELUAR_Click() Unload Me End Sub Private Sub KODEBARANG_KeyPress(KeyAscii As Integer) On Error Resume Next If KeyAscii = 13 Then TBLBARANG.Recordset.MoveFirst TBLBARANG.Recordset.Find "kode='" & KODEBARANG.Text & "'" If Len(Trim(KODEBARANG.Text)) < 4 Then MsgBox "KODE BARANG HARUS DI ISI DENGAN 4 DIGIT ", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 Exit Sub End If If TBLBARANG.Recordset.EOF Then aktif (True) WARNA (vbWhite) NAMABARANG.SetFocus STOK.Text = 0 STOK.BackColor = &HE0E0E0 STOK.Enabled = False TANGGALBELI.BackColor = &HE0E0E0 TANGGALBELI.Enabled = False Exit Sub Else NAMABARANG.Text = TBLBARANG.Recordset!NAMABARANG HARGABELI.Text = TBLBARANG.Recordset!HARGABELI HARGAJUAL.Text = TBLBARANG.Recordset!HARGAJUAL STOK.Text = TBLBARANG.Recordset!JUMLAH HARGABELI.BackColor = vbWhite HARGABELI.Enabled = True HARGABELI.SelLength = Len(HARGABELI.Text) HARGABELI.SetFocus End If


End If End Sub Private Sub NAMABARANG_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then HARGABELI.SetFocus HARGABELI.SelLength = Len(HARGABELI.Text) End If End Sub Private Sub NOFAKTURBELI_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If NOFAKTURBELI.Text = Empty Then MsgBox " No Faktur Harus diisi" Exit Sub End If KODEBARANG.Enabled = True KODEBARANG.BackColor = vbWhite KODEBARANG.SetFocus End If End Sub Private Sub SIMPAN_Click() Dim KRETERIA As String KRETERIA = "SELECT * FROM BARANG WHERE" & Space(1) & "KODE='" & KODEBARANG.Text & "'" Dim TBCARI As New ADODB.Recordset TBCARI.CursorLocation = adUseClient TBCARI.Open KRETERIA, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False", adOpenDynamic, adLockOptimistic, adCmdText If TBCARI.RecordCount = 0 Then With TBLBARANG .Recordset.AddNew .Recordset!KODE = KODEBARANG .Recordset!NAMABARANG = NAMABARANG .Recordset!HARGABELI = HARGABELI .Recordset!HARGAJUAL = HARGAJUAL .Recordset!JUMLAH = JUMLAHBELI


.Recordset.Update End With Else With TBLBARANG .Recordset!KODE = KODEBARANG .Recordset!NAMABARANG = NAMABARANG .Recordset!HARGABELI = HARGABELI .Recordset!HARGAJUAL = HARGAJUAL .Recordset!JUMLAH = .Recordset!JUMLAH + JUMLAHBELI .Recordset.Update End With End If With TBLPEMBELIAN .Recordset.AddNew .Recordset!TGLPEMBELIAN = TANGGALBELI .Recordset!NOFAKTURBELI = NOFAKTURBELI .Recordset!KODE = KODEBARANG .Recordset!NAMABARANG = NAMABARANG .Recordset!HARGABELI = HARGABELI .Recordset!HARGAJUAL = HARGAJUAL .Recordset!JUMLAHBELI = JUMLAHBELI .Recordset.Update End With Form_Activate End Sub Sub KOSONG() NOFAKTURBELI.Text = Empty KODEBARANG.Text = Empty NAMABARANG.Text = Empty HARGABELI.Text = Empty HARGAJUAL.Text = Empty JUMLAHBELI.Text = Empty STOK.Text = Empty End Sub Sub aktif(kondisi As Boolean)


TANGGALBELI.Enabled = kondisi NOFAKTURBELI.Enabled = kondisi KODEBARANG.Enabled = kondisi NAMABARANG.Enabled = kondisi HARGABELI.Enabled = kondisi HARGAJUAL.Enabled = kondisi JUMLAHBELI.Enabled = kondisi STOK.Enabled = kondisi End Sub

Sub WARNA(depan As String) TANGGALBELI.BackColor = depan NOFAKTURBELI.BackColor = depan KODEBARANG.BackColor = depan NAMABARANG.BackColor = depan HARGABELI.BackColor = depan HARGAJUAL.BackColor = depan JUMLAHBELI.BackColor = depan STOK.BackColor = depan End Sub

8. FORM PENJUALAN

Private Sub BATAL_Click() Form_Activate NAMAPEMBELI.Enabled = True NAMAPEMBELI.BackColor = vbWhite NAMAPEMBELI.SetFocus End Sub Private Sub ALAMAT_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then KODEBARANG.Enabled = True KODEBARANG.BackColor = vbWhite KODEBARANG.SetFocus End If


End Sub Private Sub CETAK_Click() Dim X As String TBLPENJUALAN.Recordset.MoveLast X = TBLPENJUALAN.Recordset!NOMORFAKTUR cr1.ReportFileName = App.Path & "\form\lapslip.rpt" cr1.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" cr1.RetrieveDataFiles cr1.SelectionFormula = "{penjualan.nomorfaktur}='" & Trim(X) & "'" cr1.WindowState = crptMaximized 'Cr.Destination = crptToPrinter cr1.DiscardSavedData = True cr1.Action = 1 End Sub Private Sub JUMLAHBAYAR_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If Val(TOTALHARGA.Text) > Val(JUMLAHBAYAR.Text) Then MsgBox " Uang anda kurang sebesar Rp " & Val(TOTALHARGA.Text) Val(JUMLAHBAYAR.Text) Exit Sub End If KEMBALI.Text = Val(JUMLAHBAYAR.Text) Val(TOTALHARGA.Text) SIMPAN.Enabled = True SIMPAN.SetFocus End If End Sub Private Sub JUMLAHJUAL_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If Val(JUMLAHJUAL) > TBLBARANG.Recordset!JUMLAH Then MsgBox "Jumlah stok yang ada hanya : " & JUMLAHSTOK.Text & "" JUMLAHJUAL.Text = Empty Exit Sub End If If JUMLAHJUAL.Text = Empty Then MsgBox " Jumlah Jual jangan dikosongkan" Exit Sub


End If PENJUALANSELESAI.Enabled = True TAMBAHPENJUALAN.Enabled = True TAMBAHPENJUALAN.SetFocus End If End Sub Private Sub KELUAR_Click() Unload Me End Sub Private Sub KODEBARANG_KeyDown(KeyCode As Integer, Shift As Integer) ' On Error GoTo SALAH: If KeyCode = 13 Then If KODEBARANG.Text = Empty Then MsgBox "KODE BARANG HARUS DI ISI", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 KODEBARANG.SelLength = Len(KODEBARANG.Text) Exit Sub End If If Len(Trim(KODEBARANG.Text)) < 4 Then MsgBox "KODE BARANG HARUS DI ISI DENGAN 4 DIGIT ", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 Exit Sub End If If TBLBARANG.Recordset.RecordCount > 0 Then TBLBARANG.Recordset.MoveFirst End If TBLBARANG.Recordset.Find "KODE=" & KODEBARANG.Text If TBLBARANG.Recordset.EOF Then MsgBox "KODE BARANG TIDAK DITEMUKAN", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 KODEBARANG.SelLength = Len(KODEBARANG.Text)


Exit Sub End If NAMABARANG.Text = TBLBARANG.Recordset!NAMABARANG HARGAJUAL.Text = TBLBARANG.Recordset!HARGAJUAL JUMLAHSTOK.Text = TBLBARANG.Recordset!JUMLAH JUMLAHJUAL.Enabled = True JUMLAHJUAL.BackColor = vbWhite JUMLAHJUAL.SetFocus End If Exit Sub SALAH: MsgBox Err.Description, vbInformation + vbOKOnly, "PESAN KESALAHAN" End Sub

Private Sub NAMAPEMBELI_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If NAMAPEMBELI.Text = Empty Then MsgBox "Nama Pembeli harus diisi" Exit Sub End If ALAMAT.Enabled = True ALAMAT.BackColor = vbWhite ALAMAT.SetFocus End If End Sub Sub ATURDAFTAR() DAFTAR.Rows = 1 DAFTAR.TextMatrix(0, 0) = "KODE BARANG" DAFTAR.TextMatrix(0, 1) = "NAMA BARANG" DAFTAR.TextMatrix(0, 2) = "HARGA" DAFTAR.TextMatrix(0, 3) = "JUMLAH" DAFTAR.FixedAlignment(0) = 3 DAFTAR.FixedAlignment(1) = 3 DAFTAR.FixedAlignment(2) = 3 DAFTAR.FixedAlignment(3) = 3


DAFTAR.ColAlignment(0) = 1 DAFTAR.ColAlignment(1) = 1 DAFTAR.ColAlignment(2) = 3 DAFTAR.ColAlignment(3) = 3 DAFTAR.ColWidth(0) = 0.1 * DAFTAR.Width DAFTAR.ColWidth(1) = 0.7 * DAFTAR.Width DAFTAR.ColWidth(2) = 0.2 * DAFTAR.Width DAFTAR.ColWidth(2) = 0.1 * DAFTAR.Width End Sub Private Sub DAFTAR_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then If DAFTAR.Rows = 2 Then DAFTAR.Rows = 1 JUMLAHJUAL.Text = 0 DAFTAR.Enabled = False PENJUALANSELESAI.Enabled = False HARGAJUAL.Enabled = True HARGAJUAL.BackColor = vbWhite HARGAJUAL.SetFocus Exit Sub End If GROW = DAFTAR.Row If DAFTAR.Row >= 0 Then DAFTAR.RemoveItem DAFTAR.Row End If If DAFTAR.Rows <= 6 Then DAFTAR.ColWidth(0) = 0.6 * DAFTAR.Width End If End If End Sub Private Sub PENJUALANSELESAI_Click() Call KOSONGTEKSDAFTAR PENJUALANSELESAI.Enabled = False JUMLAHBAYAR.Enabled = True JUMLAHBAYAR.BackColor = vbWhite


JUMLAHBAYAR.SetFocus End Sub Private Sub Form_Activate() On Error GoTo SALAH: Call KOSONGTEKS Call KOSONGTEKSDAFTAR Call KONDISITEKS(False) Call WARNATEKS(&HE0E0E0) Call WARNATEKSDAFTAR(&HE0E0E0) If TBLPENJUALAN.Recordset.RecordCount <= 0 Then NOMORFAKTUR.Text = 1 Else TBLPENJUALAN.Recordset.MoveLast NOMORFAKTUR.Text = Val(TBLPENJUALAN.Recordset!NOMORFAKTUR) + 1 End If TAMBAHPENJUALAN.Enabled = False PENJUALANSELESAI.Enabled = False SIMPAN.Enabled = False CETAK.Enabled = False DAFTAR.Enabled = False TANGGALJUAL.Text = Format(Date, "DD-MM-YYYY") NAMAPEMBELI.BackColor = vbWhite NAMAPEMBELI.Enabled = True NAMAPEMBELI.SetFocus NAMAPEMBELI.SelStart = 0 NAMAPEMBELI.SelLength = 10 TOTALHARGA.Text = Empty JUMLAHBAYAR.Text = Empty KEMBALI.Text = Empty ATURDAFTAR Exit Sub SALAH: MsgBox Err.Description, vbInformation + vbOKOnly, "PESAN KESALAHAN" Unload Me End Sub


Private Sub Form_Load() TBLBARANG.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLBARANG.CommandType = adCmdTable TBLBARANG.RecordSource = "BARANG" TBLBARANG.Refresh TBLPENJUALAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\form\BARANG.mdb" & ";Persist Security Info=False" TBLPENJUALAN.CommandType = adCmdTable TBLPENJUALAN.RecordSource = "PENJUALAN" TBLPENJUALAN.Refresh End Sub

Sub KOSONGTEKS() TANGGALJUAL.Text = Empty NOMORFAKTUR.Text = Empty NAMAPEMBELI.Text = Empty ALAMAT.Text = Empty KODEBARANG.Text = Empty NAMABARANG.Text = Empty HARGAJUAL.Text = Empty JUMLAHJUAL.Text = Empty JUMLAHSTOK.Text = Empty NOMORFAKTUR.MaxLength = 4 NAMABARANG.MaxLength = 100 KODEBARANG.MaxLength = 4 End Sub

Sub KOSONGTEKSDAFTAR() KODEBARANG.Text = "" NAMABARANG.Text = "" HARGAJUAL.Text = "" JUMLAHSTOK.Text = ""


JUMLAHJUAL.Text = "" End Sub Sub KONDISITEKS(KEADAAN As Boolean) TANGGALJUAL.Enabled = KEADAAN NOMORFAKTUR.Enabled = KEADAAN NAMAPEMBELI.Enabled = KEADAAN ALAMAT.Enabled = KEADAAN KODEBARANG.Enabled = KEADAAN NAMABARANG.Enabled = KEADAAN HARGAJUAL.Enabled = KEADAAN JUMLAHJUAL.Enabled = KEADAAN JUMLAHSTOK.Enabled = KEADAAN TOTALHARGA.Enabled = KEADAAN JUMLAHBAYAR.Enabled = KEADAAN KEMBALI.Enabled = KEADAAN End Sub

Sub WARNATEKS(WARNA As String) TANGGALJUAL.BackColor = WARNA NOMORFAKTUR.BackColor = WARNA NAMAPEMBELI.BackColor = WARNA ALAMAT.BackColor = WARNA KODEBARANG.BackColor = WARNA NAMABARANG.BackColor = WARNA HARGAJUAL.BackColor = WARNA JUMLAHJUAL.BackColor = WARNA JUMLAHSTOK.BackColor = WARNA TOTALHARGA.BackColor = WARNA JUMLAHBAYAR.BackColor = WARNA KEMBALI.BackColor = WARNA End Sub Sub WARNATEKSDAFTAR(WARNA As String) HARGAJUAL.BackColor = WARNA JUMLAHJUAL.BackColor = WARNA End Sub Private Sub MATAKULIAH_KeyDown(KeyCode As Integer, Shift As Integer)


If KeyCode = 13 Then SKS.Enabled = True SKS.BackColor = vbWhite SKS.SetFocus End If End Sub Private Sub SIMPAN_Click() 'On Error GoTo SALAH Dim JLHDATA As Integer For JLHDATA = 1 To DAFTAR.Rows - 1 TBLPENJUALAN.Recordset.AddNew TBLPENJUALAN.Recordset!TGLJUAL = TANGGALJUAL.Text TBLPENJUALAN.Recordset!NOMORFAKTUR = NOMORFAKTUR.Text TBLPENJUALAN.Recordset!NAMAPEMBELI = NAMAPEMBELI.Text TBLPENJUALAN.Recordset!ALAMAT = ALAMAT.Text TBLPENJUALAN.Recordset!KODEBARANG = DAFTAR.TextMatrix(JLHDATA, 0) TBLPENJUALAN.Recordset!NAMABARANG = DAFTAR.TextMatrix(JLHDATA, 1) TBLPENJUALAN.Recordset!HARGAJUAL = DAFTAR.TextMatrix(JLHDATA, 2) TBLPENJUALAN.Recordset!JUMLAH = DAFTAR.TextMatrix(JLHDATA, 3) TBLPENJUALAN.Recordset.Update TBLBARANG.Recordset.MoveFirst TBLBARANG.Recordset.Find "kode='" & DAFTAR.TextMatrix(JLHDATA, 0) & "'" If TBLBARANG.Recordset.RecordCount = 0 Then MsgBox "DATA TIDAK ADA" Else With TBLBARANG .Recordset!JUMLAH = .Recordset!JUMLAH Val(DAFTAR.TextMatrix(JLHDATA, 3)) .Recordset.Update End With End If


Next JLHDATA Call Form_Activate TANGGALJUAL.Enabled = True TANGGALJUAL.BackColor = vbWhite TANGGALJUAL.SetFocus CETAK.Enabled = True CETAK.SetFocus Exit Sub SALAH: MsgBox Err.Description, vbOKOnly + vbInformation, "PESAN KESALAHAN" KONEKSI.RollbackTrans End Sub Private Sub SKS_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then PRT.Enabled = True PRT.BackColor = vbWhite PRT.SetFocus End If End Sub Private Sub TAMBAHPENJUALAN_Click() DAFTAR.Enabled = True DAFTAR.Rows = DAFTAR.Rows + 1 NewRow = DAFTAR.Rows - 1 DAFTAR.TextMatrix(NewRow, 0) = KODEBARANG.Text DAFTAR.TextMatrix(NewRow, 1) = NAMABARANG.Text DAFTAR.TextMatrix(NewRow, 2) = HARGAJUAL.Text DAFTAR.TextMatrix(NewRow, 3) = JUMLAHJUAL.Text TOTALHARGA.Text = Val(TOTALHARGA.Text) + (Val(DAFTAR.TextMatrix(NewRow, 2)) * Val(DAFTAR.TextMatrix(NewRow, 3))) If DAFTAR.Rows = 7 Then DAFTAR.ColWidth(0) = 0.57 * DAFTAR.Width End If PENJUALANSELESAI.Enabled = True Call KOSONGTEKSDAFTAR Call WARNATEKSDAFTAR(&HE0E0E0)


KODEBARANG.Enabled = True KODEBARANG.SetFocus TAMBAHPENJUALAN.Enabled = False End Sub Private Sub TUTUP_Click() KONEKSI.Close Set TBLBARANG = Nothing Unload Me End Sub

9. FORM PERANCANG

Private Sub Command1_Click() Unload Me End Sub

10. FORM REKTUR PENJUALAN

Private Sub CMDCETAK_Click() ReturJ.ReportFileName = App.Path & "\form\LapReturJual.rpt" ReturJ.DataFiles(0) = App.Path & "\FORM\BARANG.MDB" ReturJ.RetrieveDataFiles ReturJ.SelectionFormula = "{Retur.Nofak}='" & NofakJ.Text & "'" ReturJ.WindowState = crptMaximized ReturJ.DiscardSavedData = True ReturJ.Action = 1 End Sub Private Sub JUMLAHRETUR_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Val(JUMLAHJUAL.Text) < Val(JUMLAHRETUR.Text) Then MsgBox "Jumlah Retur salah"


Exit Sub End If SIMPAN.Enabled = True SIMPAN.SetFocus End If End Sub Private Sub KELUAR_Click() Unload Me End Sub Private Sub BATAL_Click() Form_Activate NOMORFAKTUR.Enabled = True NOMORFAKTUR.BackColor = vbWhite NOMORFAKTUR.SetFocus End Sub Private Sub JUMLAHJUAL_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then If JUMLAHJUAL > TBLBARANG.Recordset!JUMLAH Then MsgBox "Jumlah stok yang ada hanya : " & JUMLAHSTOK.Text & "" JUMLAHJUAL.Text = Empty Exit Sub End If If JUMLAHJUAL.Text = Empty Then MsgBox " Jumlah Jual jangan dikosongkan" Exit Sub End If PENJUALANSELESAI.Enabled = True TAMBAHPENJUALAN.Enabled = True TAMBAHPENJUALAN.SetFocus End If End Sub Private Sub KODEBARANG_KeyDown(KeyCode As Integer, Shift As Integer) On Error GoTo SALAH: If KeyCode = 13 Then If KODEBARANG.Text = Empty Then


MsgBox "KODE BARANG HARUS DI ISI", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 KODEBARANG.SelLength = Len(KODEBARANG.Text) Exit Sub End If If Len(Trim(KODEBARANG.Text)) < 4 Then MsgBox "KODE BARANG HARUS DI ISI DENGAN 4 DIGIT ", vbOKOnly + vbCritical, "KONFIRMASI" KODEBARANG.SelStart = 0 Exit Sub End If If TBLBARANG.Recordset.RecordCount > 0 Then TBLBARANG.Recordset.MoveFirst End If TBLPENJUALAN.CommandType = adCmdText TBLPENJUALAN.RecordSource = "Select * From penjualan Where NOMORFAKTUR='" & NOMORFAKTUR.Text & "'AND KODEBARANG='" & KODEBARANG & "'" TBLPENJUALAN.Refresh If TBLPENJUALAN.Recordset.RecordCount <= 0 Then MsgBox "Transaksi ini tidak ditemukan!", vbCritical KODEBARANG.SetFocus Exit Sub End If TANGGALJUAL.Text = TBLPENJUALAN.Recordset!TGLJUAL NAMAPEMBELI.Text = TBLPENJUALAN.Recordset!NAMAPEMBELI ALAMAT.Text = TBLPENJUALAN.Recordset!ALAMAT NAMABARANG.Text = TBLPENJUALAN.Recordset!NAMABARANG HARGAJUAL.Text = TBLPENJUALAN.Recordset!HARGAJUAL JUMLAHJUAL.Text = TBLPENJUALAN.Recordset!JUMLAH NofakJ.Text = NOMORFAKTUR.Text JUMLAHRETUR.Enabled = True JUMLAHRETUR.BackColor = vbWhite JUMLAHRETUR.SetFocus


End If Exit Sub SALAH: MsgBox Err.Description, vbInformation + vbOKOnly, "PESAN KESALAHAN" End Sub Private Sub DAFTAR_KeyUp(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then If DAFTAR.Rows = 2 Then DAFTAR.Rows = 1 JUMLAHJUAL.Text = 0 DAFTAR.Enabled = False PENJUALANSELESAI.Enabled = False HARGAJUAL.Enabled = True HARGAJUAL.BackColor = vbWhite HARGAJUAL.SetFocus Exit Sub End If GROW = DAFTAR.Row If DAFTAR.Row >= 0 Then 'JUMLAHJUAL.Text = Val(JUMLAHJUAL.Text) DAFTAR.TextMatrix(DAFTAR.Row, 3) DAFTAR.RemoveItem DAFTAR.Row End If If DAFTAR.Rows <= 6 Then DAFTAR.ColWidth(0) = 0.6 * DAFTAR.Width End If End If End Sub Private Sub PENJUALANSELESAI_Click() Call KOSONGTEKSDAFTAR PENJUALANSELESAI.Enabled = False JUMLAHBAYAR.Enabled = True JUMLAHBAYAR.BackColor = vbWhite JUMLAHBAYAR.SetFocus End Sub


Private Sub Form_Activate() ' On Error GoTo SALAH: Call KOSONGTEKS Call KOSONGTEKSDAFTAR Call KONDISITEKS(False) Call WARNATEKS(&HE0E0E0) Call WARNATEKSDAFTAR(&HE0E0E0) SIMPAN.Enabled = False NOMORFAKTUR.Enabled = True NOMORFAKTUR.BackColor = vbWhite NOMORFAKTUR.SetFocus Exit Sub SALAH: MsgBox Err.Description, vbInformation + vbOKOnly, "PESAN KESALAHAN" Unload Me End Sub Private Sub Form_Load() TBLBARANG.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\FORM\BARANG.mdb" & ";Persist Security Info=False" TBLBARANG.CommandType = adCmdTable TBLBARANG.RecordSource = "BARANG" TBLBARANG.Refresh TBLPENJUALAN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\FORM\BARANG.mdb" & ";Persist Security Info=False" TBLPENJUALAN.CommandType = adCmdTable TBLPENJUALAN.RecordSource = "PENJUALAN" TBLPENJUALAN.Refresh TBLRETUR.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\FORM\BARANG.mdb" & ";Persist Security Info=False" TBLRETUR.CommandType = adCmdTasble TBLRETUR.RecordSource = "RETUR" TBLRETUR.Refresh End Sub


Sub KOSONGTEKS() TANGGALJUAL.Text = Empty NOMORFAKTUR.Text = Empty NAMAPEMBELI.Text = Empty ALAMAT.Text = Empty KODEBARANG.Text = Empty NAMABARANG.Text = Empty HARGAJUAL.Text = Empty JUMLAHJUAL.Text = Empty JUMLAHRETUR.Text = Empty NOMORFAKTUR.MaxLength = 4 NAMABARANG.MaxLength = 100 KODEBARANG.MaxLength = 4 End Sub Sub KOSONGTEKSDAFTAR() KODEBARANG.Text = "" NAMABARANG.Text = "" HARGAJUAL.Text = "" JUMLAHJUAL.Text = "" JUMLAHRETUR.Text = "" End Sub Sub KONDISITEKS(KEADAAN As Boolean) TANGGALJUAL.Enabled = KEADAAN NOMORFAKTUR.Enabled = KEADAAN NAMAPEMBELI.Enabled = KEADAAN ALAMAT.Enabled = KEADAAN KODEBARANG.Enabled = KEADAAN NAMABARANG.Enabled = KEADAAN HARGAJUAL.Enabled = KEADAAN JUMLAHJUAL.Enabled = KEADAAN JUMLAHRETUR.Enabled = KEADAAN End Sub Sub WARNATEKS(WARNA As String) TANGGALJUAL.BackColor = WARNA NOMORFAKTUR.BackColor = WARNA NAMAPEMBELI.BackColor = WARNA ALAMAT.BackColor = WARNA


KODEBARANG.BackColor = WARNA NAMABARANG.BackColor = WARNA HARGAJUAL.BackColor = WARNA JUMLAHJUAL.BackColor = WARNA JUMLAHRETUR.BackColor = WARNA End Sub Sub WARNATEKSDAFTAR(WARNA As String) HARGAJUAL.BackColor = WARNA JUMLAHJUAL.BackColor = WARNA End Sub Private Sub MATAKULIAH_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then SKS.Enabled = True SKS.BackColor = vbWhite SKS.SetFocus End If End Sub Private Sub NOMORFAKTUR_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then KODEBARANG.Enabled = True KODEBARANG.BackColor = vbWhite KODEBARANG.SetFocus End If End Sub Private Sub SIMPAN_Click() On Error GoTo SALAH TBLPENJUALAN.Recordset!JUMLAH = TBLPENJUALAN.Recordset!JUMLAH - Val(JUMLAHRETUR.Text) TBLPENJUALAN.Recordset.Update TBLBARANG.Recordset.MoveFirst TBLBARANG.Recordset.Find "kode='" & KODEBARANG.Text & "'" TBLBARANG.Recordset!JUMLAH = TBLBARANG.Recordset!JUMLAH + Val(JUMLAHRETUR.Text) TBLBARANG.Recordset.Update TBLRETUR.Recordset.AddNew TBLRETUR.Recordset!Nofak = NOMORFAKTUR.Text


TBLRETUR.Recordset!kobar = KODEBARANG.Text TBLRETUR.Recordset!nama = NAMAPEMBELI.Text TBLRETUR.Recordset!tjual = TANGGALJUAL.Text TBLRETUR.Recordset!HARGAJUAL = Val(HARGAJUAL.Text) TBLRETUR.Recordset!jlhretur = Val(JUMLAHRETUR.Text) TBLRETUR.Recordset.Update Call Form_Activate Exit Sub SALAH: MsgBox Err.Description, vbOKOnly + vbInformation, "PESAN KESALAHAN" KONEKSI.RollbackTrans End Sub Private Sub SKS_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then PRT.Enabled = True PRT.BackColor = vbWhite PRT.SetFocus End If End Sub Private Sub TAMBAHPENJUALAN_Click() DAFTAR.Enabled = True DAFTAR.Rows = DAFTAR.Rows + 1 NewRow = DAFTAR.Rows - 1 DAFTAR.TextMatrix(NewRow, 0) = KODEBARANG.Text DAFTAR.TextMatrix(NewRow, 1) = NAMABARANG.Text DAFTAR.TextMatrix(NewRow, 2) = HARGAJUAL.Text DAFTAR.TextMatrix(NewRow, 3) = JUMLAHJUAL.Text TOTALHARGA.Text = Val(TOTALHARGA.Text) + (Val(DAFTAR.TextMatrix(NewRow, 2)) * Val(DAFTAR.TextMatrix(NewRow, 3))) If DAFTAR.Rows = 7 Then DAFTAR.ColWidth(0) = 0.57 * DAFTAR.Width End If PENJUALANSELESAI.Enabled = True


Call KOSONGTEKSDAFTAR Call WARNATEKSDAFTAR(&HE0E0E0) KODEBARANG.Enabled = True KODEBARANG.SetFocus TAMBAHPENJUALAN.Enabled = False End Sub Private Sub TUTUP_Click() KONEKSI.Close Set TBLBARANG = Nothing Unload Me End Sub

11. FORM TENTANG PROGRAM

Dim P As Byte Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() P=0 End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Image1.ToolTipText = "Create & Design By : GUSNI " & Space(1) & _ "( Februari 2008 - Mei 2008, Launching : 15 Mei 2008 )" End Sub Private Sub Timer1_Timer() JUDUL.Caption = Left(JDL.Caption, P) P=P+1 If P > Len(JDL.Caption) Then P = 0 End Sub


LISTING PROGRAM. Private Sub MnCariHapus_Click() FrmEditHapusPembelian.Show vbmodal End Sub

Recommend Documents