StrSql = " SELECT * FROM Pengguna where Nama ='" & txtname.text & "' AND Pass='" & txtpass.text & "'"

1. Menu Login Private Sub Image1_Click() End Sub Private Sub OKButton_Click() Dim StrSql As String Dim NoUsr As Integer Dim DbUsr As New ADODB.Connection Dim RsUsr As New ADODB.Recordset Dim slh As Integer slh = 0 StrSql = " SELECT * FROM Pengguna where Nama ='" & txtname.Text & "' AND Pass='" & txtpass.Text & "'" DbUsr.Open StrConn DbUsr.CursorLocation = adUseClient RsUsr.Open StrSql, DbUsr If RsUsr.RecordCount = 0 Then MsgBox "Oopss User Name and Password Salah ", vbCritical, "Incorrect" slh = slh + 1 If slh = 2 Then MsgBox "Opps U had 3 times incorrect login" End End If txtname = "" txtpass = "" txtname.SetFocus Else Unload Me MainMenu.Show Set DbUsr = Nothing Set RsUsr = Nothing End If End Sub 2. Main Menu Private Sub cmdbarang_Click(Index As Integer) frmbarang.Show

End Sub Private Sub cmdpenjualan_Click(Index As Integer) frmjual.Show End Sub Private Sub cmdRepot_Click(Index As Integer) frmprint.Show End Sub Private Sub cmdsupplier_Click(Index As Integer) frmsupplier.Show End Sub Private Sub Command1_Click(Index As Integer) Dim quest As Byte tanya = MsgBox("Apakah Anda yakin akan keluar dari aplikasi ini", vbOKCancel + vbQuestion, "konfirmasi") If tanya = 1 Then End Else Exit Sub End If

End Sub Private Sub Command3_Click() frmpesan.Show End Sub 3. Input data barang Public jml, tot, hrg As Single Public kode_sup As String

Private Sub Reload() Dim NoBrg As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset Dim DbBrgx As New ADODB.Connection Dim RsBrgx As New ADODB.Recordset Dim strx As String strx = "select * from supplier" DbBrgx.Open StrConn

DbBrgx.CursorLocation = adUseClient RsBrgx.Open strx, DbBrgx

RsBrgx.MoveFirst While Not RsBrgx.EOF cmb_sup.AddItem RsBrgx!Kd_supplier & "-" & RsBrgx!Nm_Supplier RsBrgx.MoveNext Wend Set DbBrgx = Nothing Set RsBrgx = Nothing

StrSql = "Select Kd_Barang as Kode,Kd_Supplier as Kd_Suppler,No_Faktur as Faktur,Tgl_Faktur as Tanggal_Faktur,Nm_Barang as Nama" _ & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang order by Kd_Barang" DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg Set DataGrid1.DataSource = RsBrg If RsBrg.RecordCount = 0 Then txtkode = "B001" Else RsBrg.MoveLast NoBrg = Int(Right(RsBrg!kode, 3)) NoBrg = NoBrg + 1 txtkode = "B" & Format$(NoBrg, "000") Set DbBrg = Nothing Set RsBrg = Nothing End If End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub cmbsatuan_Change() cmbsatuan.Enabled = True

txtsatuanlain.Enabled = False End Sub Private Sub cmdbatal_Click() Kosong_Text End Sub Private Sub cmdcetak_Click() frmprint.SSTab1.Tab = 0 frmprint.Show 'frmview.Show 'cetak_brg ' Printer.EndDoc End Sub Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmddel_Click() Dim StrSql As String Dim DbDelete As New ADODB.Connection Dim RsDelete As New ADODB.Recordset Dim tanya As Byte StrSql = "delete from Barang where Kd_Barang='" & txtckode & "'" tanya = MsgBox("Apakah Anda Yakin Akan mendelete record ini '" & txtckode & "'", vbYesNo + vbQuestion, "Konfirmasi") If tanya = vbYes Then On Error GoTo warning DbDelete.Open StrConn RsDelete.Open StrSql, DbDelete Set DbDelete = Nothing Set RsDelete = Nothing txtckode = "" txtcnama = "" txtckode.SetFocus Reload Exit Sub warning: MsgBox "Untuk menghapus klik Kode kemudian tekan tombol hapus "

Exit Sub Else MsgBox "batal menghapus" End If End Sub Private Sub cmdrefresh_Click() Reload End Sub Private Sub cmdsearch_Click() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtckode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari End If End Sub Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function Private Sub cetak_brg() Dim NoBrg As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset

Dim MSubtotal, Mtotal As Long Dim Mno, Mhal, Mlama, Mbaris As Integer Dim MJumlah As Single Dim Mgrs As String Printer.Font = "Curier New" 'select data StrSql = "Select Kd_Barang as Kode,No_Faktur as Faktur,Nm_Barang as Nama" _ & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang order by Kd_Barang" DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg Set DataGrid1.DataSource = RsBrg If RsBrg.RecordCount = 0 Then MsgBox "Data kosong" Else RsBrg.MoveFirst 'bawa head ke awal halaman Printer.CurrentX = 0 Printer.CurrentY = 0 'start loop Mtotal = 0 Mno = 0 Mhal = 0 'loop start Do While Not RsBrg.EOF 'print header Mhal = Mhal + 1 Printer.Print "Daftar Barang" Printer.Print Tab(80); "Hal :"; Format(Mhal, "###") Mgrs = String(94, "-") Printer.Print Mgrs Printer.Print Tab(5); "No."; Printer.Print Tab(10); "Nomor."; Printer.Print Tab(34); "Kode"; Printer.Print Tab(44); "No. Faktur."; Printer.Print Tab(54); "Nama Barang."; Printer.Print Tab(64); "Satuan."; Printer.Print Tab(72); "Jumlah.";

Printer.Print Tab(10); "Harga Satuan"; Printer.Print Tab(22); "Harga Jual"; Printer.Print Tab(34); "Tgl. Expired"; Printer.Print Tab(44); "No."; Printer.Print Tab(64); "No."; Printer.Print Mgrs ' end header MSubtotal = 0 Mbaris = 0 'start print field Do While Not RsBrg.EOF And Mbaris <= 55 Mno = Mno + 1 MJumlah = RsBrg!Jumlah * RsBrg!Harga_Satuan 'RsBrg.Find "=rsBrg!=kode'" + "'" 'masih ngarang Printer.Print Tab(2); RKanan(Mno, "#,###"); Printer.Print Tab(10); RsBrg!Faktur Printer.Print Tab(22); RsBrg!Nama Printer.Print Tab(34); RsBrg!Jumlah Printer.Print Tab(44); RsBrg!Harga_Satuan Printer.Print Tab(54); RsBrg!Harga_Jual Printer.Print Tab(64); RsBrg!Tanggal_Expired Printer.Print Tab(72); RKanan(RsBrg!Harga_Satuan, "#,###") & ",-"; Printer.Print Tab(80); RKanan(RsBrg!Jumlah, "#,###"); Printer.Print Tab(88); RKanan(MJumlah, "#,###,###") & ",-" MSubtotal = MSubtotal + MJumlah Mbaris = Mbaris + 1 RsBrg.MoveNext Loop Mtotal = Mtotal + MSubtotal Printer.Print Mgrs 'end field

Printer.Print "Sub Total:"; Printer.Print Tab(79); RKanan(MSubtotal, "##,###,###") Printer.Print "Total"; Printer.Print Tab(79); RKanan(Mtotal, "##,###,###") Printer.Print Mgrs Printer.NewPage Loop Set DbBrg = Nothing Set RsBrg = Nothing

End If

End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) txtckode.Text = DataGrid1.Text End Sub Private Sub txtcnama_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset StrSql = "select * From Barang where Nm_Barang ='" & txtcnama & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari txtckode = !Kd_Barang End With End If End Sub Private Sub txthargasatuan_Change() jml = Val(txtjumlah.Text) hrg = Val(txthargasatuan.Text) tot = jml * hrg txttotal.Text = tot End Sub Private Sub Cmdupdate_Click() Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String Dim DbUpdateX As New ADODB.Connection Dim RsUpdateX As New ADODB.Recordset Dim StrUpdateX As String

Dim cek As String Dim No_Order As Variant cek = frmpesan.txtCek No_Order = frmpesan.txtckode If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtfaktur = "" Then MsgBox "isi nomor Faktur Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtnama = "" Then MsgBox "Isi nama barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmbsatuan = "" Then MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" Exit Sub 'ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False And jumadd.Text = "" Then 'MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" ' Exit Sub ElseIf txthargasatuan = "0" Or IsNumeric(txthargasatuan) = False Then MsgBox "Isi Harga Satuan Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txthargajual = "0" Or IsNumeric(txthargajual) = False Then MsgBox "Isi Harga Jual Dengan Benar", vbInformation, "Pesan" Exit Sub

Else ' On Error GoTo error_son

If txtsatuanlain <> "" Then 'jika satuan lain di isi StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur='" & tglfaktur.Value & "',Nm_Barang='" & txtnama _ & "',satuan='" & txtsatuanlain & "',Jml_Barang=" & txtjumlah _ & ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired='" & tgl.Value & "' where Kd_Barang='" & txtkode & "'" Else StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur='" & tglfaktur.Value & "',Nm_Barang='" & txtnama _ & "',satuan='" & cmbsatuan & "',Jml_Barang=" & txtjumlah _

& ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired='" & tgl.Value & "' where Kd_Barang='" & txtkode & "'" DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate Set DbUpdate = Nothing Set RsUpdate = Nothing

End If

If jumadd.Text <> "" Then ' jika reorder StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur='" & tglfaktur.Value & "',Nm_Barang='" & txtnama _ & "',satuan='" & cmbsatuan & "',Jml_Barang=" & jumadd _ & ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired='" & tgl.Value & "' where Kd_Barang='" & txtkode & "'" DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate Set DbUpdate = Nothing Set RsUpdate = Nothing

''''''''''''''''''''''''''''''''''' 'update table pesanan sudah dikirim ''''''''''''''''''''''''''''''''''' StrUpdateX = "UPDATE Pesanan set cek='" & cek & "' where No_Order='" & No_Order & "'" DbUpdateX.Open StrConn RsUpdateX.Open StrUpdateX, DbUpdateX Set DbUpdateX = Nothing Set RsUpdateX = Nothing End If Kosong_Text Reload cmdupdate.Visible = False cmdsimpan.Visible = True

Exit Sub

'error_son: 'MsgBox "Error Update" End If End Sub

Private Sub cmdsimpan_Click() Dim StrSql As String Dim DbInsert As New ADODB.Connection Dim RsInsert As New ADODB.Recordset 'take kode supplier from combo kode_sup = Left(cmb_sup.Text, 4) If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtfaktur = "" Then MsgBox "isi nomor Faktur Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmb_sup.Text = "" Then MsgBox "pilih supplier terlebih dahulu", vbInformation, "Pesan" Exit Sub ElseIf txtnama = "" Then MsgBox "Isi nama barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmbsatuan = "" Then MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False Then MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txthargasatuan = "0" Or IsNumeric(txthargasatuan) = False Then MsgBox "Isi Harga Satuan Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txthargajual = "0" Or IsNumeric(txthargajual) = False Then MsgBox "Isi Harga Jual Dengan Benar", vbInformation, "Pesan" Exit Sub

Else On Error GoTo ErrorSave

If txtsatuanlain <> "" Then

StrSql = "insert into Barang values('" & txtkode & "','" & kode_sup & "','" & txtfaktur & "','" & tglfaktur.Value & "','" & txtnama _ & "','" & txtsatuanlain & "'," & txtjumlah & "," & txthargasatuan & "," & txthargajual & "," & tot & ",'" & tgl.Value & "')"

Else StrSql = "insert into Barang values('" & txtkode & "','" & kode_sup & "','" & txtfaktur & "','" & tglfaktur.Value & "','" & txtnama _ & "','" & cmbsatuan & "'," & txtjumlah & "," & txthargasatuan & "," & txthargajual & "," & tot & ",'" & tgl.Value & "')"

End If

DbInsert.Open StrConn RsInsert.Open StrSql, DbInsert MsgBox "Record ditambahkan" Set DbInsert = Nothing Set RsInsert = Nothing Kosong_Text Reload Exit Sub ErrorSave: MsgBox "Error Save" End If End Sub

Private Sub Form_Load() StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False" Reload Label5.Caption = "Today:" & Date End Sub

Private Sub txtkode_Change() Dim StrSql As String

Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text Else cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Barang txtfaktur = !No_Faktur cmbsatuan = !Satuan txtjumlah = !Jml_Barang txthargasatuan = !Harga_Satuan txthargajual = !Harga_Jual tgl.Value = !Tgl_expired End With End If Else cmdupdate.Visible = False cmdsimpan.Visible = True Kosong_Text End If End Sub

Private Sub Kosong_Text() txtnama = "" cmbsatuan = "" txtsatuanlain = "" txtjumlah = "" txthargasatuan = "" txthargajual = "" End Sub

Private Sub txtsatuanlain_Change() cmbsatuan.Enabled = False txtsatuanlain.Enabled = True End Sub

4. Input Supplier ''''''''''''''''''''''''''' ' have fun coding ' ''''''''''''''''''''''''''' Private Sub Reload() ' mark Dim NoSpl As Integer Dim DbSpl As New ADODB.Connection Dim RsSpl As New ADODB.Recordset StrSql = "Select Kd_Supplier as Kode,Nm_Supplier as Nama" _ & ",Alamat as Alamat,Kota as Kota,Contact_Name as Contact" _ & ",Telp as Telp,Fax as Faximile" _ & " From Supplier order by Kd_Supplier" DbSpl.Open StrConn DbSpl.CursorLocation = adUseClient RsSpl.Open StrSql, DbSpl Set DataGrid1.DataSource = RsSpl If RsSpl.RecordCount = 0 Then txtkode = "S001" Else RsSpl.MoveLast NoSpl = Int(Right(RsSpl!kode, 3)) NoSpl = NoSpl + 1 txtkode = "S" & Format$(NoSpl, "000") Set DbSpl = Nothing Set RsSpl = Nothing End If End Sub Private Sub Command3_Click() Unload Me End Sub

Private Sub cmdbatal_Click() Kosong_Text End Sub Private Sub cmdcetak_Click() frmprint.SSTab1.Tab = 1 frmprint.Show 'frmview.Show 'cetak_Spl ' Printer.EndDoc End Sub Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmddel_Click() Dim StrSql As String Dim DbDelete As New ADODB.Connection Dim RsDelete As New ADODB.Recordset Dim tanya As Byte tanya = MsgBox("Apakah Anda Yakin Akan mendelete record ini", vbYesNo + vbQuestion, "Konfirmasi") If tanya = vbYes Then StrSql = "delete from Supplier where Kd_Supplier='" & txtckode & "'" On Error GoTo warning DbDelete.Open StrConn RsDelete.Open StrSql, DbDelete Set DbDelete = Nothing Set RsDelete = Nothing txtckode = "" txtcnama = "" txtckode.SetFocus Reload warning: MsgBox "Untuk menghapus klik Kode kemudian tekan tombol hapus " Exit Sub Else MsgBox "batal menghapus" End If

End Sub Private Sub cmdrefresh_Click() Reload End Sub Private Sub cmdsearch_Click() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Supplier where Kd_Supplier ='" & txtckode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari End If End Sub Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function Private Sub cetak_Spl() Dim NoSpl As Integer Dim DbSpl As New ADODB.Connection Dim RsSpl As New ADODB.Recordset Dim MSubtotal, Mtotal As Long Dim Mno, Mhal, Mlama, Mbaris As Integer Dim MJumlah As Single Dim Mgrs As String Printer.Font = "Curier New"

'select data StrSql = "Select Kd_Supplier as Kode,Nm_Supplier as Nama" _ & ",Alamat as Alamat,Kota as Kota,Contact_Name as Contact" _ & ",Telp as Telp,Fax as Faximile" _ & " From Supplier order by Kd_Supplier" DbSpl.Open StrConn DbSpl.CursorLocation = adUseClient RsSpl.Open StrSql, DbSpl Set DataGrid1.DataSource = RsSpl If RsSpl.RecordCount = 0 Then MsgBox "Data kosong" Else RsSpl.MoveFirst 'bawa head ke awal halaman Printer.CurrentX = 0 Printer.CurrentY = 0 'start loop Mtotal = 0 Mno = 0 Mhal = 0 'loop start Do While Not RsSpl.EOF 'print header Mhal = Mhal + 1 Printer.Print "Daftar Supplier" Printer.Print Tab(80); "Hal :"; Format(Mhal, "###") Mgrs = String(94, "-") Printer.Print Mgrs Printer.Print Tab(5); "No."; ''''''''''''''''''''''''belummmm Printer.Print Mgrs ' end header MSubtotal = 0 Mbaris = 0 'start print field Do While Not RsSpl.EOF And Mbaris <= 55 Mno = Mno + 1 MJumlah = RsSpl!Jumlah * RsSpl!Harga_Supplier

'RsSpl.Find "=rsSpl!=kode'" + "'" 'masih ngarang Printer.Print Tab(2); RKanan(Mno, "#,###"); Printer.Print Tab(10); RsSpl!Faktur Printer.Print Tab(22); RsSpl!Nama Printer.Print Tab(34); RsSpl!Jumlah Printer.Print Tab(44); RsSpl!Harga_Supplier Printer.Print Tab(54); RsSpl!txtfax Printer.Print Tab(64); RsSpl!Tanggal_Expired Printer.Print Tab(72); RKanan(RsSpl!Harga_Supplier, "#,###") & ",-"; Printer.Print Tab(80); RKanan(RsSpl!Jumlah, "#,###"); Printer.Print Tab(88); RKanan(MJumlah, "#,###,###") & ",-" MSubtotal = MSubtotal + MJumlah Mbaris = Mbaris + 1 RsSpl.MoveNext Loop Mtotal = Mtotal + MSubtotal Printer.Print Mgrs 'end field

Printer.Print "Sub Total:"; Printer.Print Tab(79); RKanan(MSubtotal, "##,###,###") Printer.Print "Total"; Printer.Print Tab(79); RKanan(Mtotal, "##,###,###") Printer.Print Mgrs Printer.NewPage Loop Set DbSpl = Nothing Set RsSpl = Nothing End If

End Sub

Private Sub txtcnama_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset StrSql = "select * From Supplier where Nm_Supplier ='" & txtcnama & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient

Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari txtckode = !Kd_supplier End With End If End Sub Private Sub Cmdupdate_Click() Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtnama = "" Then MsgBox "Isi nama Supplier Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtalamat = "" Then MsgBox "Isi Alamat Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtkota = "" Then MsgBox "Isi Kota Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtcontact = "" Then MsgBox "Isi Contact Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txttelepon = "0" Or IsNumeric(txttelepon) = False Then MsgBox "Isi Telepon Dengan Benar", vbInformation, "Pesan" Exit Sub

Else On Error GoTo pesan_error StrUpdate = "UPDATE Supplier set Nm_Supplier='" & txtnama _ & "',Alamat='" & txtalamat & "',Kota='" & txtkota _ & "',Contact_Name='" & txtcontact & "',Telp='" & txttelepon _ & "',Fax='" & txtfax & "' where Kd_Supplier='" & txtkode & "'"

DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate MsgBox "Data Updated" Set DbUpdate = Nothing Set RsUpdate = Nothing Kosong_Text Reload Exit Sub

pesan_error: MsgBox "opps error update" End If End Sub

Private Sub cmdsimpan_Click() Dim StrSql As String Dim DbInsert As New ADODB.Connection Dim RsInsert As New ADODB.Recordset Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtnama = "" Then MsgBox "Isi nama Supplier Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtalamat = "" Then MsgBox "Isi Alamat Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtkota = "" Then MsgBox "Isi Kota Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtcontact = "" Then MsgBox "Isi Contact Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txttelepon = "0" Or IsNumeric(txttelepon) = False Then

MsgBox "Isi Telepon Dengan Benar", vbInformation, "Pesan" Exit Sub

Else On Error GoTo pesan StrSql = "insert into Supplier values('" & txtkode & "','" & txtnama _ & "','" & txtalamat & "','" & txtkota & "','" & txtcontact & "','" & txttelepon & "','" & txtfax & "')" DbInsert.Open StrConn RsInsert.Open StrSql, DbInsert MsgBox "Record ditambahkan" Set DbInsert = Nothing Set RsInsert = Nothing Kosong_Text Reload Exit Sub pesan: MsgBox "Opps Error" End If End Sub

Private Sub Form_Load() StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False" Reload End Sub Private Sub SSTab1_GotFocus() Dim StrSql As String Dim NoSpl As Integer Dim DbSpl As New ADODB.Connection Dim RsSpl As New ADODB.Recordset

If SSTab1.Caption = "Search" Then txtckode.SetFocus StrSql = "Select Kd_Supplier as Kode,Nm_Supplier as Nama" _ & ",Alamat as Alamat,Kota as Kota,Contact_Name as Contact" _ & ",Telp as Telp,Fax as Faximile" _

& " From Supplier order by Kd_Supplier" DbSpl.Open StrConn DbSpl.CursorLocation = adUseClient RsSpl.Open StrSql, DbSpl Set DataGrid1.DataSource = RsSpl End If Set DbSpl = Nothing Set RsSpl = Nothing End Sub Private Sub txtkode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Supplier where Kd_Supplier ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text Else cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Supplier txtalamat = !Alamat txtkota = !Kota txtcontact = !Contact_Name txttelepon = !Telp txtfax = !Fax

End With End If Else Kosong_Text

cmdupdate.Visible = False cmdsimpan.Visible = True End If End Sub

Private Sub Kosong_Text() txtnama = "" txtalamat = "" txttelepon = "" txtfax = "" txtkota = "" txtcontact = "" End Sub 5. Serch Penjualan Public jml, tot, hrg, curstok As Single Private Sub Reload() Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset StrSql = "SELECT TranJual.No,TranJual.No_Faktur, TranJual.No_Rek," _ & " TranJual.Tgl_Faktur, TranJual.Kd_Barang,TranJual.Nm_Barang, TranJual.Tgl_Spb," _ & " TranJual.Tgl_Pembayaran, TranJual.Jatuh_Tempo, TranJual.Qty," _ & " TranJual.Harga_Satuan, TranJual.Total FROM TranJual" DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual If RsJual.RecordCount = 0 Then txtfaktur = "F001" Else RsJual.MoveLast NoJual = Int(Right(RsJual!No_Faktur, 3)) NoJual = NoJual + 1 txtfaktur = "F" & Format$(NoJual, "000") Set DbJual = Nothing

Set RsJual = Nothing End If End Sub Private Sub cmdbatal_Click() Kosong_Text End Sub Private Sub cmdcetak_Click() 'frmprint.SSTab1.Tab = 2 frmprint.Show 'frmViewjual.Show 'cetak_Jual ' Printer.EndDoc End Sub Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmddel_Click() Dim StrSql As String Dim DbDelete As New ADODB.Connection Dim RsDelete As New ADODB.Recordset Dim tanya As Byte Dim X As Integer StrSql = "DELETE FROM TranJual where TranJual.no=" & txtno.Text & " " tanya = MsgBox("Apakah Anda Yakin Akan mendelete record dengan No '" & txtno.Text & "'", vbYesNo + vbQuestion, "Konfirmasi") If tanya = vbYes Then On Error GoTo warning DbDelete.Open StrConn RsDelete.Open StrSql, DbDelete Set DbDelete = Nothing Set RsDelete = Nothing txtckode = "" txtcnama = "" txtCNoFaktur.SetFocus Reload Exit Sub warning: MsgBox "untuk menhapus record klik pada cell No kemudian klik tombol Hapus"

Else MsgBox "batal menghapus" End If End Sub Private Sub cmdfakturbaru_Click() Reload End Sub Private Sub cmdrefresh_Click() Reload End Sub Private Sub cmdsearch_Click() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtCNoFaktur) = 4 Then StrSql = "select * From TranJual where No_Faktur ='" & txtCNoFaktur & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then MsgBox "Data Tidak ditemukan ( Kosong )" Reload Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari End If End Sub Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function Private Sub cetak_Jual()

Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset Dim MSubtotal, Mtotal As Long Dim Mno, Mhal, Mlama, Mbaris As Integer Dim MJumlah As Single Dim Mgrs As String Printer.Font = "Curier New" 'select data StrSql = "SELECT TranJual.No_Faktur, TranJual.No_Rek, TranJual.Tgl_Faktur," _ & "TranJual.Kd_Barang,TranJual.Nm_Barang, TranJual.Tgl_Spb, TranJual.Tgl_Pembayaran," _ & "TranJual.Jatuh_Tempo, TranJual.Qty, TranJual.Harga_Satuan, TranJual.Total FROM TranJual ORDER BY No_Faktur"

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual If RsJual.RecordCount = 0 Then MsgBox "Data kosong" Else RsJual.MoveFirst 'bawa head ke awal halaman Printer.CurrentX = 0 Printer.CurrentY = 0 'start loop Mtotal = 0 Mno = 0 Mhal = 0 'loop start Do While Not RsJual.EOF 'print header Mhal = Mhal + 1 Printer.Print "Daftar Barang" Printer.Print Tab(80); "Hal :"; Format(Mhal, "###") Mgrs = String(94, "-") Printer.Print Mgrs Printer.Print Tab(5); "No."; Printer.Print Tab(10); "Nomor."; Printer.Print Tab(34); "Kode";

Printer.Print Tab(44); "No. Faktur."; Printer.Print Tab(54); "Nama Barang."; Printer.Print Tab(64); "Satuan."; Printer.Print Tab(72); "Jumlah."; Printer.Print Tab(10); "Harga Satuan"; Printer.Print Tab(22); "Harga Jual"; Printer.Print Tab(34); "Tgl. Expired"; Printer.Print Tab(44); "No."; Printer.Print Tab(64); "No."; Printer.Print Mgrs ' end header MSubtotal = 0 Mbaris = 0 'start print field Do While Not RsJual.EOF And Mbaris <= 55 Mno = Mno + 1 MJumlah = RsJual!Jumlah * RsJual!Harga_Satuan 'RsJual.Find "=rsJual!=kode'" + "'" 'masih ngarang Printer.Print Tab(2); RKanan(Mno, "#,###"); Printer.Print Tab(10); RsJual!Faktur Printer.Print Tab(22); RsJual!Nama Printer.Print Tab(34); RsJual!Jumlah Printer.Print Tab(44); RsJual!Harga_Satuan Printer.Print Tab(54); RsJual!Harga_Jual Printer.Print Tab(64); RsJual!Tanggal_Expired Printer.Print Tab(72); RKanan(RsJual!Harga_Satuan, "#,###") & ",-"; Printer.Print Tab(80); RKanan(RsJual!Jumlah, "#,###"); Printer.Print Tab(88); RKanan(MJumlah, "#,###,###") & ",-" MSubtotal = MSubtotal + MJumlah Mbaris = Mbaris + 1 RsJual.MoveNext Loop Mtotal = Mtotal + MSubtotal Printer.Print Mgrs 'end field Printer.Print "Sub Total:"; Printer.Print Tab(79); RKanan(MSubtotal, "##,###,###") Printer.Print "Total"; Printer.Print Tab(79); RKanan(Mtotal, "##,###,###") Printer.Print Mgrs Printer.NewPage Loop

Set DbJual = Nothing Set RsJual = Nothing End If

End Sub Private Sub txtckode_Change() 'for search record Barang Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtckode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari End If End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) Dim a As String txtno.Text = DataGrid1.Text End Sub Private Sub txtkode_KeyPress(KeyAscii As Integer) 'KeyAscii = UCase(Chr(KeyAscii)) End Sub

Private Sub txtqty_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset jml = Val(txtqty.Text) hrg = Val(txthargajual.Text) tot = jml * hrg If Len(txtqty.Text) <> 0 Then StrSql = "select Jml_Barang From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari curstok = Rscari!Jml_Barang If Rscari.RecordCount = 0 Then MsgBox "Stok Barang Kosong", vbCritical End If If Val(txtqty.Text) > Rscari!Jml_Barang Then MsgBox "Qty barang melebihi stok barang Mencukupi Untuk dijual", vbCritical txtqty.Text = "" End If End If txttotal.Text = tot End Sub Private Sub Cmdupdate_Click() 'not done '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' think abaout update record satu faktur mungkin banyak ' transaksi jadi kemungkinan buatkan id ''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String Dim DbRtv As New ADODB.Connection Dim RsRtv As New ADODB.Recordset Dim StrRtv As String cmdUpdate2.Enabled = True StrRtv = "SELECT * FROM TranJual where TranJual.no=" & txtno.Text & ""

DbRtv.Open StrConn RsRtv.Open StrRtv, DbRtv SSTab1.Tab = 0 If Not RsRtv.EOF Or RsRtv.BOF Then With RsRtv txtkode = !Kd_Barang txtnama = !Nm_Barang txtqty = !qty End With End If 'If txtkode = "" Or Len(txtkode) < 4 Then ' MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" ' Exit Sub ' ElseIf txtfaktur = "" Then '' MsgBox "isi nomor Faktur Dengan Benar", vbInformation, "Pesan" ' Exit Sub ' ElseIf txtnama = "" Then ' MsgBox "Isi nama barang Dengan Benar", vbInformation, "Pesan" ' Exit Sub ' ElseIf cmbsatuan = "" Then ''' MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" ' Exit Sub '' ' ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False Then ' MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" ' Exit Sub ' ' ElseIf txthargasatuan = "0" Or IsNumeric(txthargasatuan) = False Then ' MsgBox "Isi Harga Satuan Dengan Benar", vbInformation, "Pesan" ' Exit Sub ' '

ElseIf txthargajual = "0" Or IsNumeric(txthargajual) = False Then MsgBox "Isi Harga Jual Dengan Benar", vbInformation, "Pesan" '' Exit Sub

' Else ' On Error GoTo error_son ' StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur=" & tglfaktur.Value & ",Nm_Barang='" & txtnama _ ' & "',satuan='" & cmbsatuan & "',Jml_Barang=" & txtjumlah _ '' & ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired=" & tgl.Value & " where Kd_Barang='" & txtkode & "'"

'DbUpdate.Open StrConn 'R'sUpdate.Open StrUpdate, DbUpdate 'Set DbUpdate = Nothing 'Set RsUpdate = Nothing 'Kosong_Text 'Reload 'Exit Sub 'error_son: 'MsgBox "Error Update" 'End If End Sub Private Sub cmdUpdate2_Click() Cmdupdate_Click End Sub Private Sub cmdsimpan_Click() 'not done Dim StrSql As String Dim DbInsert As New ADODB.Connection Dim RsInsert As New ADODB.Recordset

Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String

Dim DbCek As New ADODB.Connection Dim RsCek As New ADODB.Recordset Dim StrCek As String

If txtfaktur = "" Or Len(txtfaktur) < 4 Then MsgBox "Isi No Faktur Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf tglpembayaran.CheckBox = False Then MsgBox "Tanggal Pembayaran Belum di Cek", vbInformation, "Pesan" Exit Sub ElseIf tglfaktur.CheckBox = False Then MsgBox "Tanggal Faktur Belum di Cek", vbInformation, "Pesan" Exit Sub

ElseIf tglsbp.CheckBox = False Then MsgBox "Tanggal SBP Belum di Cek", vbInformation, "Pesan" Exit Sub ElseIf jatuhtempo.CheckBox = False Then MsgBox "Tanggal jath tempo Belum di Cek", vbInformation, "Pesan" Exit Sub

ElseIf txtqty = "0" Or IsNumeric(txtqty) = False Then MsgBox "Isi Qty Dengan Benar", vbInformation, "Pesan" Exit Sub

Else 'start validasi record '''''''''''''''''''''''''''''''''''''''''' ' cek apakah no faktur dan kode brg sama ' jika ya maka ga boleh ' '''''''''''''''''''''''''''''''''''''''''' StrCek = "SELECT No_Faktur,Kd_Barang FROM TranJual where No_Faktur='" & txtfaktur & "' AND Kd_Barang='" & txtkode & "'" DbCek.Open StrConn RsCek.Open StrCek, DbCek If RsCek.EOF And RsCek.BOF Then GoTo InsertRec Else 'If RsCek!No_Faktur = txtfaktur.Text And RsCek!Kd_Barang Then MsgBox "Data Barang sudah ada pada faktur '" & txtfaktur & "' !,Silakan Ganti Nomor Faktur", vbCritical, "warning" Kosong_Text txtkode.SetFocus Exit Sub End If InsertRec: '''''''''''''''''''''''''''''''''''''''''' On Error GoTo ErrorSave StrSql = "insert into TranJual (No_Faktur,No_Rek,Tgl_Faktur,Kd_Barang,Nm_Barang,Tgl_Spb,Tgl_Pembayaran,Jatuh_Temp o,Qty,Harga_Satuan,Total) values('" & txtfaktur & "','" & txtrek & "','" _ & tglfaktur & "','" & txtkode & "','" & txtnama & "','" & tglsbp & "','" & tglpembayaran & "','" _ & jatuhtempo & "'," & txtqty & "," & txthargajual & "," & tot & ")"

DbInsert.Open StrConn RsInsert.Open StrSql, DbInsert MsgBox "Record ditambahkan", , "Pesan" Set DbInsert = Nothing Set RsInsert = Nothing

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' update stock barang kurangi jumlah stok barang sebanyak QTY penjualan ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' updtstok = curstok - jml StrUpdate = "update Barang set Jml_Barang=" & updtstok & " where Kd_Barang='" & txtkode & "'" DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate Set DbUpdate = Nothing Set RsUpdate = Nothing

Kosong_Text txtkode.SetFocus 'Reload Exit Sub ErrorSave: MsgBox "Oopss!! , silakan cek tanggal", vbCritical, "warning" End If

End Sub

Private Sub Form_Load() cmdUpdate2.Enabled = False tglpembayaran = "" jatuhtempo = "" tglsbp = "" tglfaktur = "" StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False" Reload

End Sub Private Sub SSTab1_GotFocus() ' 'Dim StrSQL As String 'Di 'm NoJual As Integer 'Dim DbJual As New ADODB.Connection 'Dim RsJual As New ADODB.Recordset

'If SSTab1.Caption = "Search" Then txtCNoFaktur.SetFocus 'StrSQL = "Select Kd_Barang as Kode,No_Faktur as Faktur,Nm_Barang as Nama" _ ' & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ ' & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ ' & " From barang order by Kd_Barang" ' ' ' '

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSQL, DbJual

' '

Set DataGrid1.DataSource = RsJual

'End If 'Set DbJual = Nothing 'Set RsJual = Nothing End Sub Private Sub txtkode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset UCase (txtkode.Text) If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text

Else

'

'cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Barang cmbsatuan = !Satuan txtjumlah = !Jml_Barang txthargasatuan = !Harga_Satuan txthargajual = !Harga_Jual

End With End If Else ' cmdupdate.Visible = False ' cmdsimpan.Visible = True ' Kosong_Text End If End Sub

Private Sub Kosong_Text() txtkode = "" txtqty = "" txtrek = " " tglfaktur = "" tglpembayaran = "" tglsbp = "" jatuhtempo = "" txtnama = "" txtjumlah = "" cmbsatuan = "" txthargasatuan = "" txthargajual = "" End Sub 6. Input penjualan Public jml, tot, hrg As Single Private Sub Reload() Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset StrSql = "Select * from SemJual order by No_Faktur"

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual If RsJual.RecordCount = 0 Then txtkode = "B001" Else RsJual.MoveLast NoJual = Int(Right(RsJual!kode, 3)) NoJual = NoJual + 1 txtkode = "B" & Format$(NoJual, "000") Set DbJual = Nothing Set RsJual = Nothing End If End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub cmbsatuan_Change() cmbsatuan.Enabled = True txtsatuanlain.Enabled = False End Sub Private Sub cmdbatal_Click() Kosong_Text End Sub Private Sub cmdcetak_Click() frmview.Show 'cetak_Jual ' Printer.EndDoc End Sub Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmddel_Click() Dim StrSql As String Dim DbDelete As New ADODB.Connection Dim RsDelete As New ADODB.Recordset Dim tanya As Byte

tanya = MsgBox("Apakah Anda Yakin Akan mendelete record ini", vbYesNo + vbQuestion, "Konfirmasi") If tanya = vbYes Then StrSql = "delete from Barang where Kd_Barang='" & txtckode & "'" DbDelete.Open StrConn RsDelete.Open StrSql, DbDelete Set DbDelete = Nothing Set RsDelete = Nothing txtckode = "" txtcnama = "" txtckode.SetFocus Reload Else MsgBox "batal menghapus" End If End Sub Private Sub cmdrefresh_Click() Reload End Sub Private Sub cmdsearch_Click() Dim StrSql As String Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset

Mfield = InputBox("Masukan Nama Field yang dicari(contoh:Kode)", "Search") Msyarat = InputBox("Masukan Keriteria yang dicari", "Search For" & Mfield) If IsNumeric(Msyarat) Then mkeriteria = Mfield & "=" & Msyarat ElseIf IsDate(Msyarat) Then mkeriteria = Mfield & "=" & "#" & Msyarat & "#" Else Mkriteria = Mfield & "=" & "'" & Msyarat & "'" End If

StrSql = "Select Kd_Barang as Kode,No_Faktur as Faktur,Nm_Barang as Nama" _ & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang where Kd_Barang ='" & Msyarat & "' order by Kd_Barang"

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual Set DbJual = Nothing Set RsJual = Nothing

End Sub Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function Private Sub cetak_Jual() Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset Dim MSubtotal, Mtotal As Long Dim Mno, Mhal, Mlama, Mbaris As Integer Dim MJumlah As Single Dim Mgrs As String Printer.Font = "Curier New" 'select data StrSql = "Select Kd_Barang as Kode,No_Faktur as Faktur,Nm_Barang as Nama" _ & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang order by Kd_Barang" DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual If RsJual.RecordCount = 0 Then MsgBox "Data kosong" Else RsJual.MoveFirst 'bawa head ke awal halaman Printer.CurrentX = 0

Printer.CurrentY = 0 'start loop Mtotal = 0 Mno = 0 Mhal = 0 'loop start Do While Not RsJual.EOF 'print header Mhal = Mhal + 1 Printer.Print "Daftar Barang" Printer.Print Tab(80); "Hal :"; Format(Mhal, "###") Mgrs = String(94, "-") Printer.Print Mgrs Printer.Print Tab(5); "No."; Printer.Print Tab(10); "Nomor."; Printer.Print Tab(34); "Kode"; Printer.Print Tab(44); "No. Faktur."; Printer.Print Tab(54); "Nama Barang."; Printer.Print Tab(64); "Satuan."; Printer.Print Tab(72); "Jumlah."; Printer.Print Tab(10); "Harga Satuan"; Printer.Print Tab(22); "Harga Jual"; Printer.Print Tab(34); "Tgl. Expired"; Printer.Print Tab(44); "No."; Printer.Print Tab(64); "No."; Printer.Print Mgrs ' end header MSubtotal = 0 Mbaris = 0 'start print field Do While Not RsJual.EOF And Mbaris <= 55 Mno = Mno + 1 MJumlah = RsJual!Jumlah * RsJual!Harga_Satuan 'RsJual.Find "=rsJual!=kode'" + "'" 'masih ngarang Printer.Print Tab(2); RKanan(Mno, "#,###"); Printer.Print Tab(10); RsJual!Faktur Printer.Print Tab(22); RsJual!Nama Printer.Print Tab(34); RsJual!Jumlah Printer.Print Tab(44); RsJual!Harga_Satuan Printer.Print Tab(54); RsJual!Harga_Jual Printer.Print Tab(64); RsJual!Tanggal_Expired Printer.Print Tab(72); RKanan(RsJual!Harga_Satuan, "#,###") & ",-"; Printer.Print Tab(80); RKanan(RsJual!Jumlah, "#,###");

Printer.Print Tab(88); RKanan(MJumlah, "#,###,###") & ",-" MSubtotal = MSubtotal + MJumlah Mbaris = Mbaris + 1 RsJual.MoveNext Loop Mtotal = Mtotal + MSubtotal Printer.Print Mgrs 'end field

Printer.Print "Sub Total:"; Printer.Print Tab(79); RKanan(MSubtotal, "##,###,###") Printer.Print "Total"; Printer.Print Tab(79); RKanan(Mtotal, "##,###,###") Printer.Print Mgrs Printer.NewPage Loop Set DbJual = Nothing Set RsJual = Nothing End If

End Sub

Private Sub DBGrid1_AfterColEdit(ByVal ColIndex As Integer)

Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset Mharga If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text

Else cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Barang txtfaktur = !No_Faktur cmbsatuan = !Satuan txtjumlah = !Jml_Barang txthargasatuan = !Harga_Satuan txthargajual = !Harga_Jual tgl.Value = !Tgl_expired End With End If Else cmdupdate.Visible = False cmdsimpan.Visible = True Kosong_Text End If

End Sub

Private Sub Form_Load() StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False" Dim MJumlah As Integer Dim StrSemSQL As String Dim DbSemJual As New ADODB.Connection Dim RsSemJual As New ADODB.Recordset Dim StrUpdate As String Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset

MJumlah = 0 'StrSemSQL = "Select * from SemJual order by No_Faktur" StrSemSQL = "Insert Into SemJual values(Qty=0)"

'If RsSemJual.RecordCount <> 0 Then

'RsSemJual.MoveFirst 'jika table sementara sudah ada isinya ' hapus seluruh record ' Do While Not RsSemJual.EOF ' RsSemJual.Delete ' RsSemJual.MoveNext ' Loop 'Else 'isi record dengan 15 record For i = 1 To 10 DbSemJual.Open StrConn DbSemJual.CursorLocation = adUseServer RsSemJual.Open StrSemSQL, DbSemJual Set DbSemJual = Nothing Set RsSemJual = Nothing 'RsSemJual.AddNew 'RsSemJual!Qty = 0 'RsSemJual!Harga = 0 'RsSemJual.Update Next i 'End If

'StrUpdate = "UPDATE SemJual SET Qty=0,Harga_Satuan=0" 'isi record dengan 15 record 'For i = 1 To 10 'DbUpdate.Open StrConn 'DbUpdate.CursorLocation = adUseClient 'RsUpdate.Open StrUpdate, DbUpdate 'Next i '' ke record pertama 'RsUpdate.MoveFirst '' isi tabel sementara 'Set DataGrid1.DataSource = RsUpdate ' 'txtfaktur.SetFocus 'Set DbUpdate = Nothing 'Set RsUpdate = Nothing ' End Sub

Private Sub txtckode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtckode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari End If End Sub

Private Sub txtcnama_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset StrSql = "select * From Barang where Nm_Barang ='" & txtcnama & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari txtckode = !Kd_Barang

End With End If End Sub Private Sub txthargasatuan_Change() jml = Val(txtjumlah.Text) hrg = Val(txthargasatuan.Text) tot = jml * hrg txttotal.Text = tot End Sub Private Sub Cmdupdate_Click() Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtfaktur = "" Then MsgBox "isi nomor Faktur Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtnama = "" Then MsgBox "Isi nama barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmbsatuan = "" Then MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False Then MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txthargasatuan = "0" Or IsNumeric(txthargasatuan) = False Then MsgBox "Isi Harga Satuan Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txthargajual = "0" Or IsNumeric(txthargajual) = False Then MsgBox "Isi Harga Jual Dengan Benar", vbInformation, "Pesan" Exit Sub

Else ' On Error GoTo error_son If txtsatuanlain <> "" Then 'jika satuan lain di isi

StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur=" & tglfaktur.Value & ",Nm_Barang='" & txtnama _ & "',satuan='" & txtsatuanlain & "',Jml_Barang=" & txtjumlah _ & ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired=" & tgl.Value & " where Kd_Barang='" & txtkode & "'" Else StrUpdate = "update Barang set No_Faktur='" & txtfaktur & "',Tgl_Faktur=" & tglfaktur.Value & ",Nm_Barang='" & txtnama _ & "',satuan='" & cmbsatuan & "',Jml_Barang=" & txtjumlah _ & ",Harga_Satuan=" & txthargasatuan & ",Harga_Jual=" & txthargajual & ",total=" & tot & ",Tgl_Expired=" & tgl.Value & " where Kd_Barang='" & txtkode & "'" End If

DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate Set DbUpdate = Nothing Set RsUpdate = Nothing Kosong_Text Reload Exit Sub 'error_son: 'MsgBox "Error Update" End If End Sub

Private Sub cmdsimpan_Click() Dim StrSql As String Dim DbInsert As New ADODB.Connection Dim RsInsert As New ADODB.Recordset If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub

Else On Error GoTo ErrorSave If txtsatuanlain <> "" Then

StrSql = "insert into Barang values('" & txtkode & "','" & txtfaktur & "','" & tglfaktur.Value & "','" & txtnama _ & "','" & txtsatuanlain & "'," & txtjumlah & "," & txthargasatuan & "," & txthargajual & "," & tot & "," & tgl.Value & ")"

Else StrSql = "insert into Barang values('" & txtkode & "','" & txtfaktur & "','" & tglfaktur.Value & "','" & txtnama _ & "','" & cmbsatuan & "'," & txtjumlah & "," & txthargasatuan & "," & txthargajual & "," & tot & "," & tgl.Value & ")"

End If

DbInsert.Open StrConn RsInsert.Open StrSql, DbInsert MsgBox "Record ditambahkan" Set DbInsert = Nothing Set RsInsert = Nothing Kosong_Text Reload Exit Sub ErrorSave: MsgBox "Error Save" End If End Sub

Private Sub SSTab1_GotFocus() Dim StrSql As String Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset

If SSTab1.Caption = "Search" Then txtckode.SetFocus

StrSql = "Select Kd_Barang as Kode,No_Faktur as Faktur,Nm_Barang as Nama" _ & ",Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang order by Kd_Barang" DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGrid1.DataSource = RsJual End If Set DbJual = Nothing Set RsJual = Nothing End Sub Private Sub txtkode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text Else cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Barang txtfaktur = !No_Faktur cmbsatuan = !Satuan txtjumlah = !Jml_Barang txthargasatuan = !Harga_Satuan txthargajual = !Harga_Jual tgl.Value = !Tgl_expired End With

End If Else cmdupdate.Visible = False cmdsimpan.Visible = True Kosong_Text End If End Sub

Private Sub Kosong_Text() txtnama = "" cmbsatuan = "" txtsatuanlain = "" txtjumlah = "" txthargasatuan = "" txthargajual = "" End Sub Private Sub txtsatuanlain_Change() cmbsatuan.Enabled = False txtsatuanlain.Enabled = True End Sub

7. input pesanan Public jml, tot, hrg As Single Public kode_sup As String Public kirim As String Private Sub Reload() Dim NoBrg As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset Dim DbBrgx As New ADODB.Connection Dim RsBrgx As New ADODB.Recordset Dim strx As String

Dim DbBrgxx As New ADODB.Connection Dim RsBrgxx As New ADODB.Recordset Dim strxx As String strx = "select * from supplier" DbBrgx.Open StrConn DbBrgx.CursorLocation = adUseClient

RsBrgx.Open strx, DbBrgx RsBrgx.MoveFirst While Not RsBrgx.EOF cmb_sup.AddItem RsBrgx!Kd_supplier & "-" & RsBrgx!Nm_Supplier RsBrgx.MoveNext Wend Set DbBrgx = Nothing Set RsBrgx = Nothing

strxx = "select * from Barang" DbBrgxx.Open StrConn DbBrgxx.CursorLocation = adUseClient RsBrgxx.Open strxx, DbBrgxx RsBrgxx.MoveFirst While Not RsBrgxx.EOF cmbbar.AddItem RsBrgxx!Kd_Barang & "-" & RsBrgxx!Nm_Barang RsBrgxx.MoveNext Wend Set DbBrgxx = Nothing Set RsBrgxx = Nothing

StrSql = "Select No_Order as No_Order,Tgl_Order as Tanggal_Order,Kd_Barang as Kd_Barang,Nm_Barang as Nm_Barang,Kd_Supplier as Kd_Suppler,Nm_Barang as Nama" _ & ",Jml as Jumlah,cek as Dikirim From Pesanan order by No_Order" DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg Set DataGrid1.DataSource = RsBrg If RsBrg.RecordCount = 0 Then txtkode = "O001" Else RsBrg.MoveLast NoBrg = Int(Right(RsBrg!No_Order, 3)) NoBrg = NoBrg + 1 txtkode.Text = "O" & Format$(NoBrg, "000") Set DbBrg = Nothing Set RsBrg = Nothing End If

End Sub Private Sub Command3_Click() Unload Me End Sub Private Sub cmbsatuan_Change() cmbsatuan.Enabled = True txtsatuanlain.Enabled = False End Sub Private Sub cmdbatal_Click() Kosong_Text End Sub Private Sub cmdCancel_Click() SSTab1.Tab = 1 Frame3.Visible = False End Sub Private Sub cmdcetak_Click() frmprint.SSTab1.Tab = 3 frmprint.Show 'frmview.Show 'cetak_brg ' Printer.EndDoc End Sub Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmddel_Click() Dim StrSql As String Dim DbDelete As New ADODB.Connection Dim RsDelete As New ADODB.Recordset Dim tanya As Byte StrSql = "delete from Pesanan where No_Order='" & txtckode & "'" tanya = MsgBox("Apakah Anda Yakin Akan mendelete record ini '" & txtckode & "'", vbYesNo + vbQuestion, "Konfirmasi") If tanya = vbYes Then On Error GoTo warning DbDelete.Open StrConn RsDelete.Open StrSql, DbDelete Set DbDelete = Nothing

Set RsDelete = Nothing txtckode = "" txtcnama = "" txtckode.SetFocus Reload Exit Sub warning: MsgBox "Untuk menghapus klik Kode kemudian tekan tombol hapus " Exit Sub Else MsgBox "batal menghapus" End If End Sub Private Sub cmdrefresh_Click() Reload End Sub Private Sub cmdsearch_Click() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Pesanan where No_Order ='" & txtckode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari End With End If Else Set DataGrid1.DataSource = Rscari

End If End Sub Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function

Private Sub cmdEdit_click() Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String Dim DbRtv As New ADODB.Connection Dim RsRtv As New ADODB.Recordset Dim StrRtv As String cmdsimpan.Visible = False cmdbatal.Visible = False cmdupdate.Enabled = True cmdCancel.Visible = True

StrRtv = "SELECT * FROM Pesanan where Pesanan.No_Order='" & txtckode.Text & "'" DbRtv.Open StrConn RsRtv.Open StrRtv, DbRtv SSTab1.Tab = 0 If Not RsRtv.EOF Or RsRtv.BOF Then With RsRtv txtkode = !No_Order

End With End If

End Sub Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) txtckode.Text = DataGrid1.Text End Sub

Private Sub optneworder_Click() Dim NoBrgYY As Integer Dim DbBrgYY As New ADODB.Connection Dim RsBrgYY As New ADODB.Recordset txtkodebrg.Enabled = True txtnama.Enabled = True cmbbar.Enabled = False ' lookup table Barang for counter and put in txtkodebrg StrSqlYY = "Select Kd_Barang FROM Barang" DbBrgYY.Open StrConn DbBrgYY.CursorLocation = adUseClient RsBrgYY.Open StrSqlYY, DbBrgYY If RsBrgYY.RecordCount = 0 Then txtkodebrg = "O001" Else RsBrgYY.MoveLast NoBrgYY = Int(Right(RsBrgYY!Kd_Barang, 3)) NoBrgYY = NoBrgYY + 1 txtkodebrg = "O" & Format$(NoBrgYY, "000") Set DbBrgYY = Nothing Set RsBrgYY = Nothing End If End Sub Private Sub optreorder_Click() cmbbar.Enabled = True txtkodebrg.Enabled = False txtnama.Enabled = False txtkodebrg.Text = "" End Sub Private Sub optY_Click() Dim add As Byte kirim = "Y" txtCek.Text = "Y"

add = MsgBox("Masukan ke data barang?", vbYesNo + vbQuestion, "Konfirmasi") If add = vbYes Then 'Unload Me With frmbarang .cmb_sup = Left(cmb_sup.Text, 4) .txtkode = Left(cmbbar.Text, 4) 'if reorder

.txtnama = Mid(cmbbar.Text, 6, Len(cmbbar.Text)) ' if reorder .cmbsatuan = cmbsatuan.Text .jumadd = txtjumlah End With frmbarang.Show Else optN.Value = True txtCek.Text = "N" End If End Sub Private Sub optN_Click() kirim = "N" txtCek.Text = "N" End Sub Private Sub SSTab1_Click(PreviousTab As Integer) Reload optreorder.Enabled = True optneworder.Enabled = True End Sub Private Sub txtcnama_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset StrSql = "select * From Barang where Nm_Barang ='" & txtcnama & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Set DataGrid1.DataSource = Rscari Else With Rscari Set DataGrid1.DataSource = Rscari txtckode = !Kd_Barang End With End If End Sub Private Sub txthargasatuan_Change() jml = Val(txtjumlah.Text) hrg = Val(txthargasatuan.Text) tot = jml * hrg

txttotal.Text = tot End Sub Private Sub Cmdupdate_Click() Dim DbUpdate As New ADODB.Connection Dim RsUpdate As New ADODB.Recordset Dim StrUpdate As String 'take kode supplier from combo kode_sup = Left(cmb_sup.Text, 4) kodebrx = Left(cmbbar.Text, 4) nmbrg = Mid(cmbbar.Text, 6, Len(cmbbar.Text)) If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmb_sup.Text = "" Then MsgBox "pilih supplier terlebih dahulu", vbInformation, "Pesan" Exit Sub ElseIf optneworder.Value = True And txtnama = "" Then MsgBox "opps Nama barang harus diisi", vbInformation, "Pesan" Exit Sub

ElseIf cmbsatuan = "" Then MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False Then MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" Exit Sub

Else ' On Error GoTo error_son If txtsatuanlain.Text <> "" Then 'if user pic other quantity StrUpdate = "update Pesanan set Tgl_Order='" & tglorder.Value & "',Kd_Barang='" & kodebrx & "',Nm_Barang='" & nmbrg & "',Kd_Supplier='" & cmb_sup.Text & "',Jml='" & txtjumlah.Text & "',Satuan='" & txtsatuanlain.Text & "',cek='" & txtCek.Text & "' where Pesanan.No_Order='" & txtckode.Text & "'" Else StrUpdate = "update Pesanan set Tgl_Order='" & tglorder.Value & "',Kd_Barang='" & kodebrx & "',Nm_Barang='" & nmbrg & "',Kd_Supplier='" & cmb_sup.Text & "',Jml='" & txtjumlah.Text & "',Satuan='" & cmbsatuan.Text & "',cek='" & txtCek.Text & "' where Pesanan.No_Order='" & txtckode.Text & "'" End If

If txtsatuanlain <> "" Then

'if user pic other quantity

StrUpdate = "update Pesanan SET Tgl_Order='" & tglorder.Value & "',Kd_barang='" & txtkodebrg.Text & "',Nm_Barang='" & txtnama.Text & "',Kd_Supplier='" & cmb_sup.Text & "',Jml=" & txtjumlah.Text & ",Satuan='" & txtsatuanlain.Text & "',cek='" & txtCek.Text & "' where No_Order='" & txtckode.Text & "'" Else StrUpdate = "update Pesanan SET Tgl_Order='" & tglorder.Value & "',Kd_barang='" & txtkodebrg.Text & "',Nm_Barang='" & txtnama.Text & "',Kd_Supplier='" & cmb_sup.Text & "',Jml=" & txtjumlah.Text & ",Satuan='" & cmbsatuan.Text & "',cek='" & txtCek.Text & "' where No_Order='" & txtckode.Text & "'" End If

DbUpdate.Open StrConn RsUpdate.Open StrUpdate, DbUpdate Set DbUpdate = Nothing Set RsUpdate = Nothing Kosong_Text Reload cmdupdate.Visible = False cmdsimpan.Visible = True

Exit Sub error_son: MsgBox "Error Update" End If End Sub Private Sub cmdsimpan_Click() Dim StrSql As String Dim DbInsert As New ADODB.Connection Dim RsInsert As New ADODB.Recordset 'take kode supplier from combo kode_sup = Left(cmb_sup.Text, 4) kodebrx = Left(cmbbar.Text, 4) nmbrg = Mid(cmbbar.Text, 6, Len(cmbbar.Text)) If txtkode = "" Or Len(txtkode) < 4 Then MsgBox "Isi Kode Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf cmb_sup.Text = "" Then

MsgBox "pilih supplier terlebih dahulu", vbInformation, "Pesan" Exit Sub ElseIf optreorder.Value = False And optneworder.Value = False Then MsgBox "opps pilih reorder atau new order dahulu", vbInformation, "Pesan" Exit Sub ElseIf optneworder.Value = True And txtnama = "" Then MsgBox "opps Nama barang harus diisi", vbInformation, "Pesan" Exit Sub

ElseIf cmbsatuan = "" Then MsgBox "Isi Satuan Barang Dengan Benar", vbInformation, "Pesan" Exit Sub ElseIf txtjumlah = "0" Or IsNumeric(txtjumlah) = False Then MsgBox "Isi jumlah Dengan Benar", vbInformation, "Pesan" Exit Sub

Else On Error GoTo ErrorSave If optreorder.Value = True Then 'if user choose reorder If txtsatuanlain.Text <> "" Then 'if user pic other quantity StrSql = "insert into Pesanan values('" & txtkode & "','" & tglorder.Value & "','" & kodebrx & "','" & nmbrg & "','" & kode_sup & "','" & txtjumlah & "'," & txtsatuanlain & "','" & txtCek & "')" Else StrSql = "INSERT INTO Pesanan values('" & txtkode & "','" & tglorder.Value & "','" & kodebrx & "','" & nmbrg & "','" & kode_sup & "'," & txtjumlah & ",'" & cmbsatuan & "','" & txtCek & "')" End If End If

If optneworder.Value = True Then 'if user choose new order If txtsatuanlain <> "" Then 'if user pic other quantity StrSql = "insert into Pesanan values('" & txtkode & "','" & tglorder.Value & "','" & txtkodebrg & "','" & txtnama & "','" & kode_sup & "'," & txtjumlah & ",'" & txtsatuanlain & "','" & txtCek & "')" Else StrSql = "insert into Pesanan values('" & txtkode & "','" & tglorder.Value & "','" & txtkodebrg & "','" & txtnama & "','" & kode_sup & "'," & txtjumlah & ",'" & cmbsatuan & "','" & txtCek & "')" End If End If

DbInsert.Open StrConn RsInsert.Open StrSql, DbInsert MsgBox "Record ditambahkan" Set DbInsert = Nothing Set RsInsert = Nothing Kosong_Text Reload Exit Sub ErrorSave: MsgBox "Error Save" End If End Sub

Private Sub Form_Load() Frame3.Visible = False StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False" Reload cmdupdate.Visible = False cmdCancel.Visible = False End Sub

Private Sub txtkode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset If Len(txtkode.Text) = 4 Then StrSql = "select * From Pesanan where No_Order ='" & txtkode & "'" Dbcari.Open StrConn Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text Else Frame3.Visible = True

optreorder.Enabled = False optneworder.Enabled = False cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari tglorder.Value = !Tgl_Order cmb_sup.Text = !Kd_supplier cmbbar.Text = !Kd_Barang & "-" & !Nm_Barang txtkodebrg = !Kd_Barang cmbsatuan = !Satuan txtjumlah = !jml End With End If Else cmdupdate.Visible = False cmdsimpan.Visible = True Kosong_Text End If End Sub

Private Sub Kosong_Text() cmb_sup = "" cmbbar = "" cmbbar = "" txtnama = "" cmbsatuan = "" txtsatuanlain = "" txtjumlah = "" txtkodebrg = ""

End Sub Private Sub txtsatuanlain_Change() cmbsatuan.Enabled = False txtsatuanlain.Enabled = True End Sub 8. Report

Public jml, tot, hrg, curstok As Single Private Sub cmdprint_Click()

If cmbfieldBrg.Text = "" Or NCmbBrg.Text = "" Or Scmbbrg.Text = "" Then MsgBox "Opps combo field, combo start dan combo end tidak boleh kosong" Exit Sub End If InitView.Text = "" InitView.Text = "Barang" frmViewjual.Show End Sub Private Sub cmdprintPsn_Click() If cmbfieldPsn.Text = "" Or NCmbPsn.Text = "" Or SCmbPsn.Text = "" Then MsgBox "Opps combo field, combo start dan combo end tidak boleh kosong" Exit Sub End If InitView.Text = "" InitView.Text = "Pesanan" frmViewjual.Show End Sub Private Sub CmdPrintSup_Click() If cmbfieldSup.Text = "" Or SCmbSup.Text = "" Or NCmbSup.Text = "" Then MsgBox "Opps combo field, combo start dan combo end tidak boleh kosong" Exit Sub End If

InitView.Text = "" InitView.Text = "Supplier" frmViewjual.Show End Sub Private Sub CmdRefBrg_Click() ReloadBarang End Sub Private Sub cmdRefresej_Click() ReloadJual End Sub Private Sub CmdRefSup_Click() ReloadSup End Sub Private Sub CmdRefPsn_Click() ReloadPsn End Sub Private Sub Form_Load() StrConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbspib.mdb;Persist Security Info=False"

End Sub Private Sub Preview_Barang() Dim NoBrg As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset Dim MSubtotal, Mtotal As Long Dim Mno, Mhal, Mlama, Mbaris As Integer Dim MJumlah As Single Dim Mgrs As String

frmview.Font = "Curier New" 'select data StrSql = "Select Kd_Barang as Kode,No_Faktur as Faktur,Tgl_Faktur as Tanggal_Faktur,Nm_Barang as Nama" _ & ",satuan as satuan,Jml_Barang as Jumlah,Harga_Satuan as Harga_Satuan" _ & ",Harga_jual as Harga_Jual,Tgl_Expired as Tanggal_Expired" _ & " From barang order by Kd_Barang" DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg 'Set DataGrid1.DataSource = RsBrg If RsBrg.RecordCount = 0 Then MsgBox "Data kosong" Else RsBrg.MoveFirst 'bawa head ke awal halaman 'frmview.CurrentX = 0 'frmview.CurrentY = 0 'start loop Mtotal = 0 Mno = 0 Mhal = 0 'loop start Do While Not RsBrg.EOF 'print header Mhal = Mhal + 1 frmview.FontBold = True frmview.FontSize = 14 frmview.Print

frmview.Print "Daftar Barang" frmview.FontBold = False frmview.FontSize = 10 frmview.Print frmview.Print Tab(113); "Hal

:"; Format(Mhal, "###")

Mgrs = String(156, "=") frmview.Print Mgrs; frmview.Print Tab(5); "No."; frmview.Print Tab(10); "Kode"; frmview.Print Tab(18); "No. Faktur"; frmview.Print Tab(34); "Tanggal_Faktur"; frmview.Print Tab(50); "Nama Barang"; frmview.Print Tab(95); "Satuan"; frmview.Print Tab(105); "Jumlah"; frmview.Print Tab(115); "Harga Satuan"; frmview.Print Tab(130); "Harga Jual"; frmview.Print Tab(143); "Tgl. Expired"; frmview.Print Tab(156); "Total" frmview.Print Mgrs; ' end header MSubtotal = 0 Mbaris = 0 'start print field Do While Not RsBrg.EOF And Mbaris <= 55 Mno = Mno + 1 MJumlah = RsBrg!Jumlah * RsBrg!Harga_Satuan 'RsBrg.Find "=rsBrg!=kode'" + "'" 'masih ngarang frmview.Print Tab(2); RKanan(Mno, "#,###"); frmview.Print Tab(10); RsBrg!kode; frmview.Print Tab(18); RsBrg!Faktur; frmview.Print Tab(34); RsBrg!Tanggal_Faktur; frmview.Print Tab(50); RsBrg!Nama; frmview.Print Tab(95); RsBrg!Satuan; frmview.Print Tab(105); RsBrg!Jumlah; frmview.Print Tab(115); RsBrg!Harga_Satuan; frmview.Print Tab(130); RsBrg!Harga_Jual; frmview.Print Tab(143); RsBrg!Tanggal_Expired; '''''''''''''''''''''''''''''''''''''''''''''''''' 'frmview.Print Tab(110); RsBrg!Harga_Satuan; 'error Rkanan 'frmview.Print Tab(120); RKanan(RsBrg!Jumlah, "#,###");

frmview.Print Tab(156); RKanan(MJumlah, "#,###,###") & ",-" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'frmview.Print Tab(72); RKanan(RsBrg!Harga_Satuan, "#,###") & ",-"; 'frmview.Print Tab(80); RKanan(RsBrg!Jumlah, "#,###"); 'frmview.Print Tab(88); RKanan(Mjumlah, "#,###,###") & ",-" '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' MSubtotal = MSubtotal + MJumlah Mbaris = Mbaris + 1 RsBrg.MoveNext Loop Mtotal = Mtotal + MSubtotal frmview.Print Mgrs 'end field

frmview.Print "Sub Total:"; frmview.Print Tab(156); RKanan(MSubtotal, "##,###,###") frmview.Print "Total"; frmview.Print Tab(156); RKanan(Mtotal, "##,###,###") frmview.Print Mgrs Loop Set DbBrg = Nothing Set RsBrg = Nothing End If End Sub Private Sub ReloadJual() Dim NoJual As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset ' lagi cari select group by StrSql = "SELECT TranJual.No_Faktur, TranJual.No_Rek," _ & " TranJual.Tgl_Faktur, TranJual.Kd_Barang,TranJual.Nm_Barang, TranJual.Tgl_Spb," _ & " TranJual.Tgl_Pembayaran, TranJual.Jatuh_Tempo, TranJual.Qty," _ & " TranJual.Harga_Satuan, TranJual.Total FROM TranJual" DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGridjual.DataSource = RsJual If RsJual.RecordCount = 0 Then MsgBox "Data Kosong"

Else Set DataGridjual.DataSource = RsJual Set DbJual = Nothing Set RsJual = Nothing End If End Sub Private Sub ReloadBarang() Dim NoBrg As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset ' lagi cari select group by StrSql = "SELECT * FROM Barang" DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg Set DataGridbrg.DataSource = RsBrg If RsBrg.RecordCount = 0 Then MsgBox "Data Kosong" Else Set DataGridbrg.DataSource = RsBrg Set DbBrg = Nothing Set RsBrg = Nothing End If End Sub Private Sub ReloadSup() Dim NoSup As Integer Dim DbSup As New ADODB.Connection Dim RsSup As New ADODB.Recordset ' lagi cari select group by StrSql = "SELECT * FROM Supplier" DbSup.Open StrConn DbSup.CursorLocation = adUseClient RsSup.Open StrSql, DbSup Set DataGridSup.DataSource = RsSup

If RsSup.RecordCount = 0 Then MsgBox "Data Kosong" Else Set DataGridSup.DataSource = RsSup Set DbSup = Nothing Set RsSup = Nothing End If End Sub Private Sub ReloadPsn() Dim NoPsn As Integer Dim DbPsn As New ADODB.Connection Dim RsPsn As New ADODB.Recordset ' lagi cari select group by StrSql = "SELECT * FROM Pesanan" DbPsn.Open StrConn DbPsn.CursorLocation = adUseClient RsPsn.Open StrSql, DbPsn Set DataGridPsn.DataSource = RsPsn If RsPsn.RecordCount = 0 Then MsgBox "Data Kosong" Else Set DataGridPsn.DataSource = RsPsn Set DbPsn = Nothing Set RsPsn = Nothing End If End Sub

Private Sub cmbfiledJual_Click() Dim NoJual, i As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset

Scmbvalue.Clear Ncmbvalue.Clear ' lagi cari select group by If cmbfiledJual.Text = "No_Faktur" Then

StrSql = "SELECT No_Faktur FROM TranJual" End If If cmbfiledJual.Text = "Tgl_Faktur" Then StrSql = "SELECT Tgl_Faktur FROM TranJual" End If

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual 'Set DataGridjual.DataSource = RsJual If RsJual.RecordCount = 0 Then Scmbvalue.Text = "Empty" Else RsJual.MoveFirst If cmbfiledJual.Text = "No_Faktur" Then For i = 1 To RsJual.RecordCount Scmbvalue.AddItem RsJual!No_Faktur Ncmbvalue.AddItem RsJual!No_Faktur RsJual.MoveNext Next i End If If cmbfiledJual.Text = "Tgl_Faktur" Then For i = 1 To RsJual.RecordCount Scmbvalue.AddItem RsJual!Tgl_Faktur Ncmbvalue.AddItem RsJual!Tgl_Faktur RsJual.MoveNext Next i End If

Set DbJual = Nothing Set RsJual = Nothing End If

End Sub Private Sub cmbfieldSup_Click() Dim NoSup, i As Integer Dim DbSup As New ADODB.Connection Dim RsSup As New ADODB.Recordset SCmbSup.Clear NCmbSup.Clear ' lagi cari select group by If cmbfieldSup.Text = "Kd_Supplier" Then StrSql = "SELECT Kd_Supplier FROM Supplier" End If If cmbfieldSup.Text = "Nm_Supplier" Then StrSql = "SELECT Nm_Supplier FROM Supplier" End If

DbSup.Open StrConn DbSup.CursorLocation = adUseClient RsSup.Open StrSql, DbSup 'Set DataGridSup.DataSource = RsSup If RsSup.RecordCount = 0 Then MsgBox "Data Kosong" Else RsSup.MoveFirst If cmbfieldSup.Text = "Kd_Supplier" Then For i = 1 To RsSup.RecordCount SCmbSup.AddItem RsSup!Kd_supplier NCmbSup.AddItem RsSup!Kd_supplier RsSup.MoveNext Next i End If If cmbfieldSup.Text = "Nm_Supplier" Then For i = 1 To RsSup.RecordCount

SCmbSup.AddItem RsSup!Nm_Supplier NCmbSup.AddItem RsSup!Nm_Supplier RsSup.MoveNext Next i End If

Set DbSup = Nothing Set RsSup = Nothing End If

End Sub Private Sub cmbfieldBrg_Click() 'not doneDim NoBrg, i As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset Scmbbrg.Clear NCmbBrg.Clear ' lagi cari select group by If cmbfieldBrg.Text = "Kd_Barang" Then StrSql = "SELECT Kd_Barang FROM Barang" End If If cmbfieldBrg.Text = "Tgl_Faktur" Then StrSql = "SELECT Tgl_Faktur FROM Barang" End If If cmbfieldBrg.Text = "Nm_Barang" Then StrSql = "SELECT Nm_Barang FROM Barang" End If If cmbfieldBrg.Text = "Tgl_Expired" Then StrSql = "SELECT Tgl_Expired FROM Barang" End If

DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient

RsBrg.Open StrSql, DbBrg 'Set DataGridBrg.DataSource = RsBrg If RsBrg.RecordCount = 0 Then MsgBox "Data Kosong" Else RsBrg.MoveFirst If cmbfieldBrg.Text = "Kd_Barang" Then For i = 1 To RsBrg.RecordCount Scmbbrg.AddItem RsBrg!Kd_Barang NCmbBrg.AddItem RsBrg!Kd_Barang RsBrg.MoveNext Next i End If If cmbfieldBrg.Text = "Tgl_Faktur" Then For i = 1 To RsBrg.RecordCount Scmbbrg.AddItem RsBrg!Tgl_Faktur NCmbBrg.AddItem RsBrg!Tgl_Faktur RsBrg.MoveNext Next i End If If cmbfieldBrg.Text = "Nm_Barang" Then For i = 1 To RsBrg.RecordCount Scmbbrg.AddItem RsBrg!Nm_Barang NCmbBrg.AddItem RsBrg!Nm_Barang RsBrg.MoveNext Next i End If If cmbfieldBrg.Text = "Tgl_Expired" Then For i = 1 To RsBrg.RecordCount Scmbbrg.AddItem RsBrg!Tgl_expired NCmbBrg.AddItem RsBrg!Tgl_expired RsBrg.MoveNext Next i End If

Set DbBrg = Nothing Set RsBrg = Nothing

End If

End Sub Private Sub cmbfieldPsn_Click() Dim NoBrg, i As Integer Dim DbPsn As New ADODB.Connection Dim RsPsn As New ADODB.Recordset SCmbPsn.Clear NCmbPsn.Clear ' lagi cari select group by If cmbfieldPsn.Text = "No_Order" Then StrSql = "SELECT No_Order FROM Pesanan" End If If cmbfieldPsn.Text = "Tgl_Order" Then StrSql = "SELECT Tgl_Order FROM Pesanan" End If If cmbfieldPsn.Text = "Nm_Barang" Then StrSql = "SELECT Nm_Barang FROM Pesanan" End If

DbPsn.Open StrConn DbPsn.CursorLocation = adUseClient RsPsn.Open StrSql, DbPsn 'Set DataGridBrg.DataSource = RsPsn If RsPsn.RecordCount = 0 Then MsgBox "Data Kosong" Else RsPsn.MoveFirst If cmbfieldPsn.Text = "No_Order" Then For i = 1 To RsPsn.RecordCount SCmbPsn.AddItem RsPsn!No_Order

NCmbPsn.AddItem RsPsn!No_Order RsPsn.MoveNext Next i End If If cmbfieldPsn.Text = "Tgl_Order" Then For i = 1 To RsPsn.RecordCount SCmbPsn.AddItem RsPsn!Tgl_Order NCmbPsn.AddItem RsPsn!Tgl_Order RsPsn.MoveNext Next i End If If cmbfieldPsn.Text = "Nm_Barang" Then For i = 1 To RsPsn.RecordCount SCmbPsn.AddItem RsPsn!Nm_Barang NCmbPsn.AddItem RsPsn!Nm_Barang RsPsn.MoveNext Next i End If

Set DbPsn = Nothing Set RsPsn = Nothing End If End Sub Private Sub cmdprintjual_Click() If cmbfiledJual.Text = "" Or Scmbvalue.Text = "" Or Ncmbvalue.Text = "" Then MsgBox "Opps combo field, combo start dan combo end tidak boleh kosong" Exit Sub InitView.Text = "" InitView.Text = "Jual" frmViewjual.Show End If End Sub Private Sub NCmbBrg_Click() Dim NoBrg, i As Integer Dim DbBrg As New ADODB.Connection Dim RsBrg As New ADODB.Recordset Dim NowDate, stgl, ntgl As Date

' lagi cari select group by If cmbfieldBrg.Text = "Kd_Barang" Then StrSql = "SELECT * FROM Barang WHERE Kd_Barang BETWEEN '" & Scmbbrg & "' AND '" & NCmbBrg & "' " End If If cmbfieldBrg.Text = "Tgl_Faktur" Then StrSql = "SELECT * FROM Barang WHERE Tgl_Faktur BETWEEN " & CDate(Scmbbrg.Text) & " AND " & CDate(NCmbBrg.Text) & " " End If If cmbfieldBrg.Text = "Tgl_Expired" Then NowDate = Date stgl = DateValue(Scmbbrg.Text) ntgl = DateValue(NCmbBrg.Text) 'StrSql = "SELECT * FROM Barang WHERE Tgl_Expired BETWEEN " & CDate(Scmbbrg.Text) & " AND " & CDate(NCmbBrg.Text) & " AND " & CDate(NCmbBrg.Text) <= NowDate & " " StrSql = "SELECT * FROM Barang WHERE Tgl_Expired BETWEEN # " & Scmbbrg.Text & "# AND #" & NCmbBrg.Text & " # " 'StrSql = "SELECT * FROM Barang WHERE Tgl_Expired BETWEEN #8/24/2007# AND #1/12/2007# " End If DbBrg.Open StrConn DbBrg.CursorLocation = adUseClient RsBrg.Open StrSql, DbBrg Set DataGridbrg.DataSource = RsBrg Set DbBrg = Nothing Set RsBrg = Nothing End Sub Private Sub NCmbPsn_Click() Dim NoPsn, i As Integer Dim DbPsn As New ADODB.Connection Dim RsPsn As New ADODB.Recordset ' lagi cari select group by If cmbfieldPsn.Text = "No_Order" Then StrSql = "SELECT * FROM Pesanan WHERE No_Order BETWEEN '" & SCmbPsn & "' AND '" & NCmbPsn & "' " End If

If cmbfieldPsn.Text = "Tgl_Order" Then StrSql = "SELECT * FROM Pesanan WHERE Tgl_Order BETWEEN " & CDate(SCmbPsn.Text) & " AND " & CDate(NCmbPsn.Text) & " " End If If cmbfieldPsn.Text = "Nm_Barang" Then StrSql = "SELECT * FROM Pesanan WHERE Nm_Barang BETWEEN '" & SCmbPsn & "' AND '" & NCmbPsn & "'" End If

DbPsn.Open StrConn DbPsn.CursorLocation = adUseClient RsPsn.Open StrSql, DbPsn Set DataGridPsn.DataSource = RsPsn Set DbPsn = Nothing Set RsPsn = Nothing End Sub Private Sub NCmbSup_Click() Dim NoSup, i As Integer Dim DbSup As New ADODB.Connection Dim RsSup As New ADODB.Recordset ' lagi cari select group by If cmbfieldSup.Text = "Kd_Supplier" Then StrSql = "SELECT * FROM Supplier WHERE Kd_Supplier BETWEEN '" & SCmbSup & "' AND '" & NCmbSup & "' " End If If cmbfieldSup.Text = "Nm_Supplier" Then StrSql = "SELECT * FROM Supplier WHERE Nm_Supplier BETWEEN '" & SCmbSup & "' AND '" & NCmbSup & "' "

End If

DbSup.Open StrConn DbSup.CursorLocation = adUseClient

RsSup.Open StrSql, DbSup Set DataGridSup.DataSource = RsSup Set DbSup = Nothing Set RsSup = Nothing End Sub Private Sub Ncmbvalue_Click() Dim NoJual, i As Integer Dim DbJual As New ADODB.Connection Dim RsJual As New ADODB.Recordset ' lagi cari select group by If cmbfiledJual.Text = "No_Faktur" Then StrSql = "SELECT * FROM TranJual WHERE No_Faktur BETWEEN '" & Scmbvalue & "' AND '" & Ncmbvalue & "' " End If If cmbfiledJual.Text = "Tgl_Faktur" Then StrSql = "SELECT * FROM TranJual WHERE Tgl_Faktur BETWEEN #" & Scmbvalue & "# AND #" & Ncmbvalue & "# "

End If

DbJual.Open StrConn DbJual.CursorLocation = adUseClient RsJual.Open StrSql, DbJual Set DataGridjual.DataSource = RsJual Set DbJual = Nothing Set RsJual = Nothing End Sub

Private Sub cmdclose_Click() Unload Me End Sub Private Sub cmdrefresh_Click() Reload End Sub

Private Function RKanan(NData, CFormat) As String ' function for right alignment 'RKanan = Format(NData, CFormat) 'RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function

Private Sub optprtrbrg_Click() Printer.Orientation = vbPRORPortrait Printer.Orientation = vbPRORLandscape End Sub

Private Sub SSTab1_GotFocus() If SSTab1.Caption = "Barang" Then Preview_Barang End If If SSTab1.Caption = "Supplier" Then 'Preview_Supplier End If If SSTab1.Caption = "Penjualan" Then 'Preview_Penjualan End If

End Sub Private Sub txtkode_Change() Dim StrSql As String Dim Dbcari As New ADODB.Connection Dim Rscari As New ADODB.Recordset UCase (txtkode.Text) If Len(txtkode.Text) = 4 Then StrSql = "select * From Barang where Kd_Barang ='" & txtkode & "'" Dbcari.Open StrConn

Dbcari.CursorLocation = adUseClient Rscari.Open StrSql, Dbcari If Rscari.RecordCount = 0 Then Kosong_Text Else

'

'cmdupdate.Visible = True cmdsimpan.Visible = False With Rscari txtnama = !Nm_Barang cmbsatuan = !Satuan txtjumlah = !Jml_Barang txthargasatuan = !Harga_Satuan txthargajual = !Harga_Jual

End With End If Else ' cmdupdate.Visible = False ' cmdsimpan.Visible = True ' Kosong_Text End If End Sub

Private Sub Kosong_Text() txtkode = "" txtqty = ""

txtrek = " " tglfaktur = "" tglpembayaran = "" tglsbp = "" jatuhtempo = "" txtnama = "" txtjumlah = "" cmbsatuan = "" txthargasatuan = "" txthargajual = "" End Sub