KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

KEMENTERIAN PENDIDIKAN NASIONAL UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM PROGRAM STUDI D.III TEKNIK INFORMATIKA Jl. Bioteknologi No. 1 Kampus USU MEDAN – Telp/FAX. 061-8214290

KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

Nama Mahasiswa

: RIDHO S. AKBAR

NIM

: 082406200

Judul Tugas Akhir

: Perancangan Aplikasi Sistem Informasi Penjualan Pada Distro Indonesian Merch

Dosen Pembimbing

: Dr. Saib Suwilo, M.Sc

Tanggal Mulai Bimbingan : Tanggal Selesai Bimbingan :

No.

Tanggal Asisten

Pembahasan Pada Asisten

Paraf Dosen

Bimbingan

Mengenai Pada BAB

Pembimbing

Keterangan

1. 2. 3. 4. 5. 6. 7.  Kartu ini dikembalikan ke Departemen Matematika bila Bimbingan Mahasiswa telah selesai

Diketahui,

Disetujui,

Departemen Matematika FMIPA USU

Pembimbing Utama/

Ketua

Penanggung Jawab

Prof. Dr. Tulus, M.Si

Dr. Saib Suwilo, M.Sc

NIP. 196209011988031002

NIP. 196401091988031004

Universitas Sumatera Utara

SURAT KETERANGAN Hasil Uji Program Tugas Akhir

Yang bertanda tangan dibawah ini, menerangkan bahwa Mahasiswa Tugas Akhir Program Diploma III Teknik Informatika/Statistika :

Nama

:

RIDHO S. AKBAR

NIM

:

082406200

Prog. Studi

:

Teknik Informatika

Judul TA

:

PERANCANGAN

APLIKASI

SISTEM

INFORMASI

PENJUALAN PADA DISTRO INDONESIAN MERCH.

Telah melaksanakan test program Tugas Akhir Mahasiswa tersebut di atas pada tanggal…………….

Dengan Hasil

:

Sukses / Gagal

Demikian diterangkan untuk digunakan melengkapi syarat pendaftaran Ujian Meja Hijau Tugas Akhir Mahasiswa bersangkutan di Departemen Matematika FMIPA USU Medan.

Medan,

Juli 2011

Dosen Pembimbing Program Studi D3 Teknik Informatika

Dr. Saib Suwilo, M.Sc NIP. 196401091988031004


LISTING PROGRAM

1. Form Untuk Menampilkan Menu Utama Private Sub Form_KeyPress(Keyascii As Integer) If Keyascii = 27 Then End End Sub Private Sub mn1_Click() Penjualan.Show End Sub Private Sub mn2_Click() Penjualan2.Show End Sub Private Sub mnbarang_Click() Barang.Show End Sub Private Sub mnctkbarang_Click() CrystalReport1.ReportFileName = App.Path & "\Lap Barang.rpt" CrystalReport1.WindowState = crptMaximized CrystalReport1.RetrieveDataFiles CrystalReport1.DataFiles(0) = App.Path & "\ADOJual.mdb" CrystalReport1.Password = Chr(10) & "" CrystalReport1.Action = 0 End Sub Private Sub mnctkpenjualan_Click() Laporan.Show End Sub Private Sub mnkasir_Click() Kasir.Show End Sub Private Sub mnkeluar_Click() End End Sub Private Sub mnrincian_Click() Rincian.Show End Sub Private Sub mnsql_Click() UjiSQL.Show End Sub

2. Form Untuk Menampilkan Menu Login Dim A As Byte Dim B As Byte


Private Sub Form_Load() TxtNamaKsr.MaxLength = 35 TxtNamaKsr.PasswordChar = "" TxtPasswordKsr.MaxLength = 15 TxtPasswordKsr.PasswordChar = "X" TxtPasswordKsr.Enabled = False TxtKodeKsr.Enabled = False End Sub Private Sub TxtNamaKsr_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 27 Then Unload Me If Keyascii = 13 Then Call BukaDB RSkasir.Open "Select NamaKsr from Kasir where NamaKsr ='" & TxtNamaKsr & "'", Conn If RSkasir.EOF Then A = A + 1 If 1 - A = 0 Then MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _ "Nama '" & TxtNamaKsr & "' tidak dikenal" TxtNamaKsr = "" TxtNamaKsr.SetFocus ElseIf 2 - A = 0 Then MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _ "Nama '" & TxtNamaKsr & "' tidak dikenal" TxtNamaKsr = "" TxtNamaKsr.SetFocus ElseIf 3 - A = 0 Then MsgBox "Kesempatan ke " & A & " Salah" & Chr(13) & _ "Nama '" & TxtNamaKsr & "' tidak dikenal" & Chr(13) & _ "Kesempatan habis, Ulangi dari awal" 'End Conn.Close Unload Me End If Else TxtNamaKsr.Enabled = False TxtPasswordKsr.Enabled = True TxtPasswordKsr.SetFocus Conn.Close End If End If End Sub Private Sub txtpasswordksr_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 27 Then Unload Me Dim LoginKasir As String Dim KodeKasir As String Dim NamaKasir As String If Keyascii = 13 Then Call BukaDB RSkasir.Open "Select * from Kasir where NamaKsr ='" & TxtNamaKsr & "' and PasswordKsr='" & TxtPasswordKsr & "'", Conn If RSkasir.EOF Then


B = B + 1 If 1 - B = 0 Then MsgBox "Kesempatan ke " & B & " Salah" TxtPasswordKsr = "" TxtPasswordKsr.SetFocus ElseIf 2 - B = 0 Then MsgBox "Kesempatan ke " & B & " Salah" TxtPasswordKsr = "" TxtPasswordKsr.SetFocus ElseIf 3 - B = 0 Then MsgBox "Kesempatan ke " & B & " Salah" 'End Conn.Close Unload Me End If Else Unload Me Menu.Show KodeKasir = RSkasir!KodeKsr NamaKasir = RSkasir!NamaKsr TxtKodeKsr = KodeKasir TxtNamaKsr = NamaKasir Penjualan.KodeKsr = KodeKasir Penjualan.NamaKsr = NamaKasir Conn.Close End If End If End Sub Sub PeriksaTanggal() Dim CekTanggal As String Ulangi: CekTanggal = Date If CekTanggal <> Format(Date, "dd/mm/yy") Then If MsgBox("Ubah Format tanggal jadi dd/mm/yy di Control Panel, Regional Settings " & vbCrLf & _ "Customize.., Date, Short Date Style, karena program tidak dapat dijalankan!", vbCritical + vbOKCancel, "Cek Tanggal") = vbOK And CekTanggal <> Format(Date, "dd/mm/yy") Then Call Shell("rundll32.exe shell32.dll," & "Control_RunDLL INTL.CPL,,4", 1) Else End End If Pesan = MsgBox("Format Tanggal Sudah diganti..?", vbYesNo, "Konfirmasi") If Pesan = vbNo Then If CekTanggal <> Format(Date, "dd/mm/yy") Then GoTo Ulangi Else GoTo Ulangi End If End If End Sub Private Sub Timer1_Timer() If CekTanggal <> Format(Date, "dd/mm/yy") Then PeriksaTanggal Else Exit Sub End If


End Sub

3. Form Untuk Menampilkan Menu Barang Dim mvBookMark As Variant Private Sub Form_Activate() Call BukaDB Conn.CursorLocation = adUseClient RSBarang.Open "barang", Conn With RSBarang If Not (.BOF And .EOF) Then mvBookMark = .Bookmark End If End With Set DataGrid1.DataSource = RSBarang.DataSource End Sub Sub Form_Load() Text1.MaxLength Text2.MaxLength Text3.MaxLength Text4.MaxLength Text5.MaxLength KondisiAwal End Sub

= = = = =

5 30 8 8 4

Function CariData() Call BukaDB RSBarang.Open "Select * From Barang where KodeBrg='" & Text1 & "'", Conn End Function Private Sub Text1 = Text2 = Text3 = Text4 = Text5 = End Sub

KosongkanText() "" "" "" "" ""

Private Sub SiapIsi() Text1.Enabled = True Text2.Enabled = True Text3.Enabled = True Text4.Enabled = True Text5.Enabled = True End Sub Private Sub TidakSiapIsi() Text1.Enabled = False Text2.Enabled = False Text3.Enabled = False Text4.Enabled = False Text5.Enabled = False End Sub Private Sub KondisiAwal() KosongkanText


TidakSiapIsi Cmdinput.Caption = "&Input" Cmdedit.Caption = "&Edit" Cmdhapus.Caption = "&Hapus" Cmdtutup.Caption = "&Tutup" Cmdinput.Enabled = True Cmdedit.Enabled = True Cmdhapus.Enabled = True End Sub Private Sub TampilkanData() With RSBarang If Not RSBarang.EOF Then Text2 = RSBarang!NamaBrg Text3 = RSBarang!HargaBeli Text4 = RSBarang!HargaJual Text5 = RSBarang!JumlahBrg End If End With End Sub Private Sub CmdRefresh_Click() If Cmdinput.Caption = "&Simpan" Then Cmdinput.SetFocus ElseIf Cmdedit.Caption = "&Simpan" Then Cmdedit.SetFocus End If Call KondisiAwal Form_Activate End Sub Private Sub CmdInput_Click() If Cmdinput.Caption = "&Input" Then Cmdinput.Caption = "&Simpan" Cmdedit.Enabled = False Cmdhapus.Enabled = False Cmdtutup.Caption = "&Batal" SiapIsi KosongkanText Text1.SetFocus Else If Text1 = "" Or Text2 = "" Or Text3 = "" Or Text4 = "" Or Text5 = "" Then MsgBox "Data Belum Lengkap...!" Else Dim SQLTambah As String SQLTambah = "Insert Into Barang (KodeBrg,NamaBrg,HargaBeli,HargaJual,JumlahBrg) values ('" & Text1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "','" & Text5 & "')" Conn.Execute SQLTambah CmdRefresh_Click End If End If End Sub Private Sub CmdEdit_Click() If Cmdedit.Caption = "&Edit" Then Cmdinput.Enabled = False Cmdedit.Caption = "&Simpan"


Cmdhapus.Enabled = False Cmdtutup.Caption = "&Batal" SiapIsi Text1.SetFocus Else If Text2 = "" Or Text3 = "" Or Text4 = "" Or Text5 = "" Then MsgBox "Masih Ada Data Yang Kosong" Else Dim SQLEdit As String SQLEdit = "Update Barang Set NamaBrg= '" & Text2 & "', HargaBeli='" & Text3 & "', HargaJual='" & Text4 & "',JumlahBrg='" & Text5 & "' where KodeBrg='" & Text1 & "'" Conn.Execute SQLEdit CmdRefresh_Click End If End If End Sub Private Sub CmdHapus_Click() If Cmdhapus.Caption = "&Hapus" Then Cmdinput.Enabled = False Cmdedit.Enabled = False Cmdtutup.Caption = "&Batal" KosongkanText SiapIsi Text1.SetFocus End If End Sub Private Sub CmdTutup_Click() Select Case Cmdtutup.Caption Case "&Tutup" Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub Text1_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then If Len(Text1) < 5 Then MsgBox "Kode Harus 5 Digit" Text1.SetFocus Else Text2.SetFocus End If If Cmdinput.Caption = "&Simpan" Then Call CariData If Not RSBarang.EOF Then TampilkanData MsgBox "Kode Barang Sudah Ada" KosongkanText Text1.SetFocus Else Text2.SetFocus End If


End If If Cmdedit.Caption = "&Simpan" Then Call CariData If Not RSBarang.EOF Then TampilkanData Text1.Enabled = False Text2.SetFocus Else MsgBox "Kode Barang Tidak Ada" Text1 = "" Text1.SetFocus End If End If If Cmdhapus.Enabled = True Then Call CariData If Not RSBarang.EOF Then TampilkanData Pesan = MsgBox("Yakin akan dihapus", vbYesNo) If Pesan = vbYes Then Dim SQLHapus As String SQLHapus = "Delete From Barang where kodebrg= '" & Text1 & "'" Conn.Execute SQLHapus KondisiAwal CmdRefresh_Click Else KondisiAwal Cmdhapus.SetFocus End If Else MsgBox "Data Tidak ditemukan" Text1.SetFocus End If End If End If End Sub Private Sub Text2_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then Text3.SetFocus End Sub Private Sub Text3_keypress(Keyascii As Integer) If Keyascii = 13 Then Text4.SetFocus If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0 End Sub Private Sub Text4_keypress(Keyascii As Integer) If Keyascii = 13 Then If Val(Text4) <= Val(Text3) Then MsgBox "Harga jual jangan <= harga beli" Text4 = "" Text4.SetFocus Else Text5.SetFocus End If End If


If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0 End Sub Private Sub Text5_keypress(Keyascii As Integer) If Keyascii = 13 Then If Cmdinput.Enabled = True Then Cmdinput.SetFocus ElseIf Cmdedit.Enabled = True Then Cmdedit.SetFocus End If End If If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0 End Sub

4. Form Untuk Menampilkan Menu Kasir Sub Form_Load() Call BukaDB Text1.MaxLength = 5 Text2.MaxLength = 30 Text3.MaxLength = 10 Text3.PasswordChar = "X" KondisiAwal End Sub Function CariData() Call BukaDB RSkasir.Open "Select * From Kasir where KodeKsr='" & Text1 & "'", Conn End Function Private Sub Text1 = Text2 = Text3 = End Sub

KosongkanText() "" "" ""

Private Sub SiapIsi() Text1.Enabled = True Text2.Enabled = True Text3.Enabled = True End Sub Private Sub TidakSiapIsi() Text1.Enabled = False Text2.Enabled = False Text3.Enabled = False End Sub Private Sub KondisiAwal() KosongkanText TidakSiapIsi CmdInput.Caption = "&Input" CmdEdit.Caption = "&Edit" CmdHapus.Caption = "&Hapus" CmdTutup.Caption = "&Tutup" CmdInput.Enabled = True


CmdEdit.Enabled = True CmdHapus.Enabled = True End Sub Private Sub TampilkanData() With RSkasir If Not RSkasir.EOF Then Text2 = RSkasir!NamaKsr Text3 = RSkasir!PasswordKsr End If End With End Sub Private Sub CmdInput_Click() If CmdInput.Caption = "&Input" Then CmdInput.Caption = "&Simpan" CmdEdit.Enabled = False CmdHapus.Enabled = False CmdTutup.Caption = "&Batal" SiapIsi KosongkanText Text1.SetFocus Else If Text1 = "" Or Text2 = "" Or Text3 = "" Then MsgBox "Data Belum Lengkap...!" Else Dim SQLTambah As String SQLTambah = "Insert Into Kasir (KodeKsr,NamaKsr,PasswordKsr) values ('" & Text1 & "','" & Text2 & "','" & Text3 & "')" Conn.Execute SQLTambah KondisiAwal End If End If End Sub Private Sub CmdEdit_Click() If CmdEdit.Caption = "&Edit" Then CmdInput.Enabled = False CmdEdit.Caption = "&Simpan" CmdHapus.Enabled = False CmdTutup.Caption = "&Batal" SiapIsi Text1.SetFocus Else If Text2 = "" Or Text3 = "" Then MsgBox "Masih Ada Data Yang Kosong" Else Dim SQLEdit As String SQLEdit = "Update Kasir Set NamaKsr= '" & Text2 & "', PasswordKsr='" & Text3 & "' where KodeKsr='" & Text1 & "'" Conn.Execute SQLEdit KondisiAwal End If End If End Sub Private Sub CmdHapus_Click() If CmdHapus.Caption = "&Hapus" Then CmdInput.Enabled = False


CmdEdit.Enabled = False CmdTutup.Caption = "&Batal" KosongkanText SiapIsi Text1.SetFocus End If End Sub Private Sub CmdTutup_Click() Select Case CmdTutup.Caption Case "&Tutup" Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub Text1_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then If Len(Text1) < 5 Then MsgBox "Kode Harus 5 Digit" Text1.SetFocus Else Text2.SetFocus End If If CmdInput.Caption = "&Simpan" Then Call CariData If Not RSkasir.EOF Then TampilkanData MsgBox "Kode Kasir Sudah Ada" KosongkanText Text1.SetFocus Else Text2.SetFocus End If End If If CmdEdit.Caption = "&Simpan" Then Call CariData If Not RSkasir.EOF Then TampilkanData Text1.Enabled = False Text2.SetFocus Else MsgBox "Kode Kasir Tidak Ada" Text1 = "" Text1.SetFocus End If End If If CmdHapus.Enabled = True Then Call CariData If Not RSkasir.EOF Then TampilkanData Pesan = MsgBox("Yakin akan dihapus", vbYesNo) If Pesan = vbYes Then Dim SQLHapus As String


SQLHapus = "Delete From Kasir where kodeKsr= '" & Text1 & "'" Conn.Execute SQLHapus KondisiAwal Else KondisiAwal CmdHapus.SetFocus End If Else MsgBox "Data Tidak ditemukan" Text1.SetFocus End If End If End If End Sub Private Sub Text2_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then Text3.SetFocus End Sub Private Sub Text3_keypress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then If CmdInput.Enabled = True Then CmdInput.SetFocus ElseIf CmdEdit.Enabled = True Then CmdEdit.SetFocus End If End If End Sub

5. Form Untuk Menampilkan Menu Laporan Private Sub Form_Load() Call BukaDB RSPenjualan.Open "Select Distinct Tanggal From Penjualan order By 1", Conn RSPenjualan.Requery Do Until RSPenjualan.EOF Combo1.AddItem RSPenjualan!Tanggal Combo2.AddItem Format(RSPenjualan!Tanggal, "YYYY ,MM, DD") Combo3.AddItem Format(RSPenjualan!Tanggal, "YYYY ,MM, DD") RSPenjualan.MoveNext Loop For i = 1 To 12 Combo4.AddItem i Next i For i = 8 To 18 Combo5.AddItem 2000 + i Next i End Sub Private Sub Combo1_Keypress(Keyascii As Integer) If Combo1 = "" Or Keyascii = 27 Then Unload Me End Sub


'Lap Harian Private Sub Combo1_Click() CR.Reset CR.ReportFileName = App.Path & "\Lap Jual Harian.rpt" CR.Password = Chr(10) & "" CR.DataFiles(0) = App.Path & "\ADOJual.mdb" CR.SelectionFormula = "Totext({Penjualan.Tanggal})='" & Combo1 & "'" CR.WindowState = crptMaximized CR.Action = 1 End Sub Private Sub Combo2_Keypress(Keyascii As Integer) If Keyascii = 27 Then Unload Me End Sub 'Lap Mingguan (Tgl Antara) Private Sub Combo3_Click() If Combo2 = "" Then MsgBox "Tanggal awal kosong", , "Informasi" Combo2.SetFocus Exit Sub End If CR.Reset CR.ReportFileName = App.Path & "\Lap Jual Mingguan.rpt" CR.Password = Chr(10) & "" CR.DataFiles(0) = App.Path & "\ADOJual.mdb" CR.SelectionFormula = "{Penjualan.Tanggal} in date (" & Combo2.Text & ") to date (" & Combo3.Text & ")" CR.WindowState = crptMaximized CR.Action = 1 End Sub Private Sub Combo4_Keypress(Keyascii As Integer) If Keyascii = 27 Then Unload Me End Sub 'Lap Bulanan Private Sub Combo5_Click() Call BukaDB RSPenjualan.Open "select * from Penjualan where month(tanggal)='" & Val(Combo4) & "' and year(tanggal)='" & (Combo5) & "'", Conn If RSPenjualan.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Combo4.SetFocus End If CR.Reset CR.ReportFileName = App.Path & "\Lap Jual Bulanan.rpt" CR.Password = Chr(10) & "" CR.DataFiles(0) = App.Path & "\ADOJual.mdb" CR.SelectionFormula = "Month({Penjualan.Tanggal})=" & Val(Combo4.Text) & " and Year({Penjualan.Tanggal})=" & Val(Combo5.Text) CR.ReportFileName = App.Path & "\Lap Jual Bulanan.rpt" CR.WindowState = crptMaximized


CR.Action = 1 End Sub

6. Form Untuk Menampilkan Menu Transaksi Penjualan Private Sub Timer1_Timer() Jam = Time$ End Sub Private Sub Form_Activate() Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOJual.mdb" Adodc1.RecordSource = "Transaksi" Set DTGrid.DataSource = Adodc1 DTGrid.Refresh If KodeKsr = "" Then MsgBox "Kasir tidak terdeteksi" Login.Show Exit Sub End If Call BukaDB RSBarang.Open "Barang", Conn List1.Clear Do Until RSBarang.EOF List1.AddItem RSBarang!NamaBrg & Space(50) & RSBarang!KodeBrg RSBarang.MoveNext Loop Call Auto Call Tabel_Kosong Adodc1.Recordset.MoveFirst Tanggal = Date CmdSimpan.Enabled = False End Sub Private Sub Form_Load() KodeKsr = Login.TxtKodeKsr NamaKsr = Login.TxtNamaKsr DTGrid.Col = 1 CmdSimpan.Enabled = False End Sub Private Sub Auto() Call BukaDB RSPenjualan.Open "select * from Penjualan Where Faktur In(Select Max(Faktur)From Penjualan)Order By Faktur Desc", Conn RSPenjualan.Requery Dim Urutan As String * 10 Dim Hitung As Long With RSPenjualan If .EOF Then Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "0001" Faktur = Urutan Else


If Left(!Faktur, 6) <> Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) Then Urutan = Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2) + "0001" Else Hitung = (!Faktur) + 1 Urutan = (Right(Date, 2) + Mid(Date, 4, 2) + Left(Date, 2)) + Right("0000" & Hitung, 4) End If End If Faktur = Urutan End With End Sub Function Tabel_Kosong() Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF Adodc1.Recordset.Delete Adodc1.Recordset.MoveNext Loop For i = 1 To 10 Adodc1.Recordset.AddNew Adodc1.Recordset!Nomor = i Adodc1.Recordset.Update Next i DTGrid.Col = 1 End Function Private Sub DTGrid_KeyDown(KeyCode As Integer, Shift As Integer) Select Case KeyCode Case vbKeyEscape Adodc1.Recordset!Kode = Null Adodc1.Recordset!Nama = Null Adodc1.Recordset!Harga = Null Adodc1.Recordset!Jumlah = Null Adodc1.Recordset!Total = Null Adodc1.Recordset.Update Call TotalItem Call TotalHarga DTGrid.Refresh End Select End Sub Private Sub DTGrid_AfterColEdit(ByVal ColIndex As Integer) If DTGrid.Col = 1 Then Call BukaDB RSBarang.Open "Select * from Barang where Kodebrg='" & Adodc1.Recordset!Kode & "'", Conn If RSBarang.EOF Then Pesan = MsgBox("Kode Barang Tidak Terdaftar") DTGrid.Col = 1 Exit Sub End If Adodc1.Recordset!Kode = RSBarang!KodeBrg Adodc1.Recordset!Nama = RSBarang!NamaBrg Adodc1.Recordset!Harga = RSBarang!HargaJual DTGrid.Col = 4 DTGrid.Refresh Exit Sub End If


If DTGrid.Col = 4 Then Adodc1.Recordset!Jumlah = Adodc1.Recordset!Jumlah Adodc1.Recordset!Total = Adodc1.Recordset!Harga * Adodc1.Recordset!Jumlah Adodc1.Recordset.Update Adodc1.Recordset.MoveNext DTGrid.Col = 1 Call TotalHarga Call TotalItem End If End Sub Function TotalItem() On Error Resume Next Adodc1.Recordset.MoveFirst Item = 0 Do While Not Adodc1.Recordset.EOF And Adodc1.Recordset!Jumlah <> 0 Item = Item + Adodc1.Recordset!Jumlah Adodc1.Recordset.MoveNext Item = Item Loop End Function Function TotalHarga() On Error Resume Next Adodc1.Recordset.MoveFirst Total = 0 Do While Not Adodc1.Recordset.EOF And Adodc1.Recordset!Total <> 0 Total = Total + Adodc1.Recordset!Total Adodc1.Recordset.MoveNext Total = Format(Total, "#,###,###") Loop End Function Private Sub Bersihkan() Item = "" Total = "" Dibayar = "" Kembali = "" End Sub Private Sub Dibayar_KeyPress(Keyascii As Integer) If Keyascii = 13 Then If Dibayar = "" Or Val(Dibayar) < (Total) Then MsgBox "Jumlah Pembayaran Kurang" Dibayar.SetFocus Else Dibayar = Format(Dibayar, "###,###,###") If Dibayar = Total Then Kembali = Dibayar - Total Else Kembali = Format(Dibayar - Total, "###,###,###") End If CmdSimpan.Enabled = True CmdSimpan.SetFocus End If End If If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0


End Sub Private Sub CmdSimpan_Keypress(Keyascii As Integer) If Keyascii = 27 Then CmdSimpan.Enabled = False Dibayar = "" Dibayar.SetFocus End If End Sub Private Sub CmdSimpan_Click() Dim SQLTambahJual As String SQLTambahJual = "Insert Into Penjualan(Faktur,Tanggal,Jam,Total,Item,Dibayar,Kembali,KodeKsr)" & _ "values('" & Faktur & "','" & Tanggal & "','" & Jam & "','" & Total & "','" & Item & "','" & Dibayar & "','" & Kembali & "','" & KodeKsr & "')" Conn.Execute (SQLTambahJual) Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF If Adodc1.Recordset!Kode <> vbNullString Then Dim SQLTambahDetail As String SQLTambahDetail = "Insert Into Detailjual(Faktur,Kodebrg,JmlJual) " & _ "values ('" & Faktur + Adodc1.Recordset!Nomor & "','" & Adodc1.Recordset!Kode & "','" & Adodc1.Recordset!Jumlah & "')" Conn.Execute (SQLTambahDetail) End If Adodc1.Recordset.MoveNext Loop Adodc1.Recordset.MoveFirst Do While Not Adodc1.Recordset.EOF If Adodc1.Recordset!Kode <> vbNullString Then Call BukaDB RSBarang.Open "Select * from Barang where Kodebrg='" & Adodc1.Recordset!Kode & "'", Conn If Not RSBarang.EOF Then Dim Kurangi As String Kurangi = "update barang set jumlahbrg='" & RSBarang!JumlahBrg - Adodc1.Recordset!Jumlah & "' where kodebrg='" & Adodc1.Recordset!Kode & "'" Conn.Execute (Kurangi) End If End If Adodc1.Recordset.MoveNext Loop Bersihkan Form_Activate Call Cetak End Sub Private Sub CmdBatal_Click() Dibayar = "" Total = "" Item = "" Form_Activate


End Sub Private Sub Cmadodc1utup_Click() Unload Me End Sub Function Cetak() Call BukaDB RSPenjualan.Open "select * from penjualan Where Faktur In(Select Max(Faktur)From penjualan)Order By Faktur Desc", Conn Layar.Show Dim Total, JmlJual, JmlHasil As Double Dim MGrs As String Layar.Font = "Courier New" Layar.Print Layar.Print RSkasir.Open "select * From Kasir where KodeKsr= '" & RSPenjualan!KodeKsr & "'", Conn Layar.Print Tab(5); "Faktur : "; RSPenjualan!Faktur Layar.Print Tab(5); "Tanggal : "; Format(RSPenjualan!Tanggal, "DD-MMMM-YYYY") Layar.Print Tab(5); "Jam : "; Format(RSPenjualan!Jam, "HH:MM:SS") Layar.Print Tab(5); "Kasir : "; RSkasir!NamaKsr MGrs = String$(33, "-") Layar.Print Tab(5); MGrs RSDetailJual.Open "select * from detailjual Where left(Faktur,10)='" & RSPenjualan!Faktur & "'", Conn RSDetailJual.MoveFirst No = 0 Do While Not RSDetailJual.EOF No = No + 1 Set RSBarang = New ADODB.Recordset RSBarang.Open "select * From Barang where Kodebrg= '" & RSDetailJual!KodeBrg & "'", Conn RSBarang.Requery Harga = RSBarang!HargaJual Jumlah = RSDetailJual!JmlJual Hasil = Harga * Jumlah Layar.Print Tab(5); No; Space(2); RSBarang!NamaBrg Layar.Print Tab(10); RKanan(Jumlah, "##"); Space(1); "X"; Layar.Print Tab(15); Format(Harga, "###,###,###"); Layar.Print Tab(25); RKanan(Hasil, "###,###,###") RSDetailJual.MoveNext Loop Layar.Print Tab(5); MGrs Layar.Print Tab(5); "Total :"; Layar.Print Tab(25); RKanan(RSPenjualan!Total, "###,###,###"); Layar.Print Tab(5); "Dibayar :"; Layar.Print Tab(25); RKanan(RSPenjualan!Dibayar, "###,###,###"); Layar.Print Tab(5); MGrs Layar.Print Tab(5); "Kembali :"; If RSPenjualan!Dibayar = RSPenjualan!Total Then Layar.Print Tab(34); RSPenjualan!Dibayar - RSPenjualan!Total Else Layar.Print Tab(25); RKanan(RSPenjualan!Dibayar RSPenjualan!Total, "###,###,###"); End If Layar.Print Tab(5); MGrs Layar.Print Tab(5); "Terima Kasih atas kunjungan Anda"


Layar.Print Layar.Print Layar.Print Conn.Close End Function Private Function RKanan(NData, CFormat) As String RKanan = Format(NData, CFormat) RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function Private Sub List1_keyPress(Keyascii As Integer) If Keyascii = 13 Then If DTGrid.SelText <> Right(List1, 5) Then DTGrid.SelText = Right(List1, 5) Adodc1.Recordset.Update Call BukaDB RSBarang.Open "Select * from Barang where KodeBrg='" & Right(List1, 5) & "'", Conn, adOpenDynamic, adLockOptimistic RSBarang.Requery If Not RSBarang.EOF Then Adodc1.Recordset!Kode = RSBarang!KodeBrg Adodc1.Recordset!Nama = RSBarang!NamaBrg Adodc1.Recordset!Harga = RSBarang!HargaJual Adodc1.Recordset.Update DTGrid.SetFocus DTGrid.Col = 4 End If End If End If End Sub Private Sub CmdTutup_Click() Unload Me End Sub

7. Form Untuk Menampilkan Menu Rincian Penjualan Private Sub Form_Load() On Error Resume Next Call BukaDB List1.Clear RSPenjualan.Open "Select Distinct Faktur from Penjualan ", Conn Do Until RSPenjualan.EOF List1.AddItem RSPenjualan!Faktur RSPenjualan.MoveNext Loop Conn.Close Call Gelap End Sub Private Sub list1_click() Call BukaDB Conn.CursorLocation = adUseClient RSPenjualan.Open "select * from Penjualan where Faktur='" & List1.Text & "'", Conn RSPenjualan.Requery If Not RSPenjualan.EOF Then Text1 = RSPenjualan!Tanggal


RSkasir.Open "select * from Kasir where KodeKsr='" & RSPenjualan!KodeKsr & "'", Conn If Not RSkasir.EOF Then Text2 = RSkasir!NamaKsr Conn.Close Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\ADOJual.mdb" Adodc1.RecordSource = "select NamaBrg as [Nama Barang], HargaJual as [Harga Jual],JmlJual as Jumlah, HargaJual*JmlJual as Total from Barang,detailJual,penjualan where DetailJual.kodeBrg=Barang.kodeBrg and left(detailjual.faktur,10)=penjualan.faktur and penjualan.faktur='" & List1 & "'" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Call Total Call Item End Sub Private Sub List1_keyPress(Keyascii As Integer) If Keyascii = 27 Then Unload Me End Sub Function Item() Adodc1.Recordset.MoveFirst Jumlah = 0 Do While Not Adodc1.Recordset.EOF Jumlah = Jumlah + Adodc1.Recordset!Jumlah Adodc1.Recordset.MoveNext Loop Text3 = Jumlah End Function Function Total() Adodc1.Recordset.MoveFirst Jumlah = 0 Do While Not Adodc1.Recordset.EOF Jumlah = Jumlah + Adodc1.Recordset!Total Adodc1.Recordset.MoveNext Loop Text4 = Jumlah End Function Sub Gelap() Text1.Enabled Text2.Enabled Text3.Enabled Text4.Enabled End Sub

= = = =

False False False False


KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

Recommend Documents