BAHASA PEMROGRAMAN (LISTING PROGRAM)

BAHASA PEMROGRAMAN (LISTING PROGRAM) 1. Bahasa Pemrograman (Listing Program) untuk Form Menu Utama Option Explicit Dim Judul Private Sub cmdBarangMasuk_Click() FormBarangMasuk.Show FormBarangMasuk.Top = 0 FormBarangMasuk.Left = 0 End Sub

Private Sub cmdKasir_Click() formKasir.Left = 0 formKasir.Show formKasir.Top = 0 End Sub

Private Sub cmdKeluar_Click() Dim Pesan Pesan = MsgBox("Apakah Anda Akan Keluar?", vbYesNo + vbQuestion) If Pesan = vbYes Then End End Sub

Private Sub cmdLapBarangMasuk_Click() FormLapBrgMasuk.Show FormLapBrgMasuk.Top = 0 FormLapBrgMasuk.Left = 0 End Sub

Universitas Sumatera Utara

Private Sub cmdLapPenjualan_Click() FormLapPenjualan.Show FormLapPenjualan.Top = 0 FormLapPenjualan.Left = 0 End Sub

Private Sub cmdLapPersediaan_Click() FormLapPersediaan.Show FormLapPersediaan.Top = 0 FormLapPersediaan.Left = 0 End Sub

Private Sub cmdLogin_Click() FormInputUser.Show FormInputUser.Left = 0 FormInputUser.Top = 0 End Sub

Private Sub cmdPenjualan_Click() FormPenjualan.Left = 0 FormPenjualan.Show FormPenjualan.Top = 0 End Sub

Private Sub cmdPersediaan_Click() FormPersediaan.Show FormPersediaan.Top = 0 FormPersediaan.Left = 0


End Sub

Private Sub MDIForm_Load() Judul = "LINTAS GRAHA COMPUTER - " & Format(Date, "dddd, dd ,mmmm, yyyy") & Space(200) End Sub

Private Sub Timer1_Timer() 'Judul = Right(Judul, Len(Judul) - 1) + Left(Judul, 1) Judul = Right(Judul, 1) + Left(Judul, Len(Judul) - 1) Me.Caption = Judul End Sub

2. Bahasa Pemrograman (Listing Program) untuk Persediaan Option Explicit Dim CN As New ADODB.Connection Dim RsPersediaan As New ADODB.Recordset Dim A As Control Dim Pesan, D Private Sub cmdBatal_Click() KOSONG End Sub Private Sub cmdHapus_Click() If RsPersediaan.RecordCount = 0 Then MsgBox "Data Telah Habis" Exit Sub Else RsPersediaan.Delete RsPersediaan.MoveNext KOSONG End If End Sub Private Sub cmdKeluar_Click() Set CN = Nothing


Set RsPersediaan = Nothing Unload Me End Sub Public Sub Tampil() On Error Resume Next txtKdBrg = RsPersediaan!KdBrg txtNmBrg = RsPersediaan!NmBrg txtSatuan = RsPersediaan!Satuan txtHarga = RsPersediaan!Harga txtPersediaan = RsPersediaan!Persediaan End Sub Public Sub KOSONG() For Each A In Me If TypeOf A Is TextBox Then A = "" Next End Sub Private Sub cmdSimpan_Click() If Len(txtKdBrg) > 5 Then MsgBox "Kode Barang Maksimal 5 Karakter" txtKdBrg = "" Exit Sub End If If Val(txtHarga) < 0 Then MsgBox "Harga Harus Lebih Besar Dari 0" Exit Sub End If If Val(txtPersediaan) < 0 Then MsgBox "Persediaan Harus Lebih Besar Dari 0" Exit Sub End If If txtKdBrg = "" Or txtNmBrg = "" Then MsgBox "Isi Data Kode Barang dan Nama Barang" Exit Sub End If If IsNumeric(txtPersediaan) = False Or IsNumeric(txtHarga) = False Then MsgBox "Data Jumlah Persediaan dan Harga Harus Angka" Exit Sub End If RsPersediaan.Find "KdBrg='" & txtKdBrg & "'", , adSearchForward, adBookmarkFirst If RsPersediaan.EOF Then RsPersediaan.AddNew RsPersediaan!KdBrg = txtKdBrg RsPersediaan!NmBrg = txtNmBrg RsPersediaan!Satuan = txtSatuan


RsPersediaan!Harga = Val(txtHarga) RsPersediaan!Persediaan = Val(txtPersediaan) RsPersediaan.Update KOSONG Else MsgBox "Data dengan Kode Tersebut Sudah Ada" txtKdBrg = "" Exit Sub End If End Sub Private Sub dgPersediaan_Click() On Error Resume Next txtKdBrg = RsPersediaan!KdBrg txtNmBrg = RsPersediaan!NmBrg txtSatuan = RsPersediaan!Satuan txtHarga = RsPersediaan!Harga txtPersediaan = RsPersediaan!Persediaan End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.MDB" RsPersediaan.Open "Persediaan", CN, 1, 3 Set dgPersediaan.DataSource = RsPersediaan End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsPersediaan = Nothing Unload Me End Sub

3. Bahasa Pemrograman (Listing Program) untuk Barang Masuk Option Explicit Dim CN As New ADODB.Connection Dim RsBrgMasuk As New ADODB.Recordset Dim RsPersediaan As New ADODB.Recordset Dim RsDataBrgMasuk As New ADODB.Recordset Dim A As Control Dim Cari, Pesan Dim D, J, HargaLama, NOFAK Private Sub cboKdBrg_Click() RsPersediaan.MoveFirst


RsPersediaan.Find "KdBrg='" & cboKdBrg & "'" If RsPersediaan.EOF Then MsgBox "Data Tidak Ditemukan" Exit Sub Else txtNmBrg = RsPersediaan!NmBrg txtHarga = RsPersediaan!Harga txtSatuan = RsPersediaan!Satuan HargaLama = Val(RsPersediaan!Harga) End If End Sub Private Sub cboKdBrg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdBrg_Click End Sub Private Sub cmdBatal_Click() KOSONG txtNoFaktur = NOFAK End Sub Private Sub cmdHapus_Click() If RsDataBrgMasuk.RecordCount = 0 Then Exit Sub If cboKdBrg = "" Then MsgBox "Anda Harus Memilih Data Yang Akan Dihapus" Else RsPersediaan!Persediaan = Val(RsPersediaan!Persediaan) - J RsPersediaan!Harga = HargaLama RsPersediaan.Update RsDataBrgMasuk.Delete KOSONG End If txtNoFaktur = NOFAK txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub cmdKeluar_Click() Set CN = Nothing Set RsDataBrgMasuk = Nothing Set RsBrgMasuk = Nothing Set RsPersediaan = Nothing Unload Me End Sub Private Sub cmdNext_Click() If RsDataBrgMasuk.EOF Then cmdNext.Enabled = False


RsDataBrgMasuk.MoveLast Tampil Exit Sub End If RsDataBrgMasuk.MoveNext cmdPrev.Enabled = True Tampil End Sub Public Sub Tampil() On Error Resume Next txtNoFaktur = RsDataBrgMasuk!NoFaktur txtBulan = RsDataBrgMasuk!Bulan txtTgl = RsDataBrgMasuk!Tanggal cboKdBrg = RsDataBrgMasuk!KdBrg txtNmBrg = RsDataBrgMasuk!NmBrg txtSatuan = RsDataBrgMasuk!Satuan txtHarga = RsDataBrgMasuk!Harga txtJlh = RsDataBrgMasuk!Jumlah txtTHarga = RsDataBrgMasuk!TotalHarga txtPemasok = RsDataBrgMasuk!Pemasok End Sub Private Sub cmdPrev_Click() If RsDataBrgMasuk.BOF Then cmdPrev.Enabled = False RsDataBrgMasuk.MoveLast Tampil Exit Sub End If RsDataBrgMasuk.MovePrevious cmdNext.Enabled = True Tampil End Sub Private Sub cmdSimpan_Click() If RsDataBrgMasuk.RecordCount = 0 Then MsgBox "Belum AdaProses Penginputan Data" Exit Sub End If 'simpan ke tabel Barang Masuk RsDataBrgMasuk.MoveFirst Do While RsDataBrgMasuk.EOF <> True RsBrgMasuk.AddNew RsBrgMasuk!NoFaktur = RsDataBrgMasuk!NoFaktur RsBrgMasuk!Bulan = RsDataBrgMasuk!Bulan RsBrgMasuk!Tanggal = RsDataBrgMasuk!Tanggal RsBrgMasuk!KdBrg = RsDataBrgMasuk!KdBrg RsBrgMasuk!NmBrg = RsDataBrgMasuk!NmBrg


RsBrgMasuk!Satuan = RsDataBrgMasuk!Satuan RsBrgMasuk!Harga = RsDataBrgMasuk!Harga RsBrgMasuk!Jumlah = RsDataBrgMasuk!Jumlah RsBrgMasuk!TotalHarga = RsDataBrgMasuk!TotalHarga RsBrgMasuk!Pemasok = RsDataBrgMasuk!Pemasok RsBrgMasuk.Update RsDataBrgMasuk.MoveNext Loop Set RsDataBrgMasuk = Nothing RsDataBrgMasuk.Open "delete from DataBarangMasuk", CN, 1, 3 DGBarangMasuk.Refresh Set DGBarangMasuk.DataSource = RsDataBrgMasuk KOSONG RsBrgMasuk.MoveLast txtNoFaktur = Format(Val(Left(RsBrgMasuk!NoFaktur, 4)) + 1, "0000") & "BM" txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub cmdTambah_Click() Set RsDataBrgMasuk = Nothing RsDataBrgMasuk.Open "DataBarangMasuk", CN, 1, 3 If txtNoFaktur = "" Or cboKdBrg = "" Or txtHarga = "" Or txtJlh = "" Then MsgBox "Lengkapi data nofaktur,jlh masuk,harga dan kode barang" Exit Sub End If 'update tabel stok RsPersediaan.Find "KdBrg='" & cboKdBrg & "'", , adSearchForward, adBookmarkFirst RsPersediaan!Persediaan = (RsPersediaan!Persediaan) + J If Val(txtHarga) > Val(RsPersediaan!Harga) Then RsPersediaan!Harga = Val(txtHarga) RsPersediaan.Update 'simpan ke tabel databeli RsDataBrgMasuk.AddNew RsDataBrgMasuk!NoFaktur = txtNoFaktur RsDataBrgMasuk!Bulan = txtBulan RsDataBrgMasuk!Tanggal = txtTgl RsDataBrgMasuk!KdBrg = cboKdBrg RsDataBrgMasuk!NmBrg = txtNmBrg RsDataBrgMasuk!Satuan = txtSatuan RsDataBrgMasuk!Harga = txtHarga RsDataBrgMasuk!Jumlah = txtJlh RsDataBrgMasuk!TotalHarga = Val(txtTHarga) RsDataBrgMasuk!Pemasok = txtPemasok RsDataBrgMasuk.Update NOFAK = txtNoFaktur


KOSONG txtNoFaktur = NOFAK Set DGBarangMasuk.DataSource = RsDataBrgMasuk cmdNext.Enabled = True cmdPrev.Enabled = True txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub DGBarangMasuk_Click() Tampil End Sub Public Sub KOSONG() For Each A In Me If TypeOf A Is TextBox Then A = "" txtNoFaktur.SetFocus End If Next For Each A In Me If TypeOf A Is ComboBox Then A = "" Next End Sub

Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.MDB" RsPersediaan.Open "Persediaan", CN, 1, 3 RsBrgMasuk.Open "BarangMasuk", CN, 1, 3 RsDataBrgMasuk.Open "DataBarangMasuk", CN, 1, 3 For D = 1 To RsPersediaan.RecordCount cboKdBrg.AddItem RsPersediaan!KdBrg RsPersediaan.MoveNext Next txtTgl = Date txtBulan = Format(Date, "MMMM") Set DGBarangMasuk.DataSource = RsBrgMasuk If RsBrgMasuk.RecordCount = 0 Then txtNoFaktur = "0001" & "-BM" Else RsBrgMasuk.MoveLast txtNoFaktur = Format(Val(Left(RsBrgMasuk!NoFaktur, 4)) + 1, "0000") & "BM" End If End Sub


Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsBrgMasuk = Nothing Set RsPersediaan = Nothing Set RsDataBrgMasuk = Nothing Unload Me End Sub Private Sub txtJlh_Change() If IsNumeric(txtJlh) = False Then Exit Sub RsPersediaan.MoveFirst RsPersediaan.Find "KdBrg='" & cboKdBrg & "'" J = Val(txtJlh) If J < 0 Then MsgBox "Ketik Jumlah Jual Dengan Benar" Exit Sub End If txtTHarga = Val(txtHarga) * Val(txtJlh) End Sub

4. Bahasa Pemrograman (Listing Program) untuk Kasir Option Explicit Dim CN As New ADODB.Connection Dim RsKasir As New ADODB.Recordset Dim Pesan

Private Sub cmdBatal_Click() txtKdKasir = "" txtNmKasir = "" txtKdKasir.SetFocus End Sub Private Sub cmdClose_Click() Set CN = Nothing Set RsKasir = Nothing Unload Me End Sub Private Sub cmdHapus_Click() If RsKasir.RecordCount = 0 Then MsgBox "Data Record Telah Habis" Exit Sub Else RsKasir.Delete RsKasir.MoveNext End If


txtKdKasir = "" txtNmKasir = "" End Sub Private Sub cmdSimpan_Click() If Len(txtKdKasir) > 5 Then MsgBox "Kode Kasir Maksimal 5 Karakter" txtKdKasir = "" txtKdKasir.SetFocus Exit Sub End If RsKasir.Find "KdKasir='" & txtKdKasir & "'", , adSearchForward, adBookmarkFirst If RsKasir.EOF Then RsKasir.AddNew RsKasir!KdKasir = txtKdKasir RsKasir!NmKasir = txtNmKasir RsKasir.Update txtKdKasir = "" txtNmKasir = "" txtKdKasir.SetFocus Else MsgBox "Data Dengan Nomor Kode Tsb Telah Ada" txtKdKasir.SetFocus Exit Sub End If End Sub Private Sub dg1_Click() On Error Resume Next txtKdKasir = RsKasir!KdKasir txtNmKasir = RsKasir!NmKasir End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.mdb" RsKasir.Open "Kasir", CN, 1, 3 Set dg1.DataSource = RsKasir End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsKasir = Nothing Unload Me End Sub


Public Sub Tampil() On Error Resume Next txtKdKasir = RsKasir!KdKasir txtNmKasir = RsKasir!NmKasir End Sub

5. Bahasa Pemrograman (Listing Program) untuk Input User Option Explicit Dim CN As New ADODB.Connection Dim RsLogin As New ADODB.Recordset Private Sub cmdH_Click() If txtU = "" Then MsgBox "Pilih salah satu data yang akan dihapus dengan mengklik data gridnya" Exit Sub End If RsLogin.Delete End Sub Private Sub cmdK_Click() Set CN = Nothing Set RsLogin = Nothing Unload Me End Sub Private Sub cmdS_Click() If txtU = "" Or txtP = "" Then MsgBox "Lengkapi Data" Exit Sub End If RsLogin.Find "User='" & txtU & "'", , adSearchForward, adBookmarkFirst If RsLogin.EOF Then RsLogin.AddNew RsLogin!User = txtU RsLogin!Pas = txtP RsLogin.Update txtU = "" txtP = "" Else MsgBox "Data dengan nama user tersebut telah ada" Exit Sub End If End Sub


Private Sub dg1_Click() txtU = RsLogin!User txtP = RsLogin!Pas End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.MDB" RsLogin.Open "Login", CN, 1, 3 Set dg1.DataSource = RsLogin End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsLogin = Nothing Unload Me End Sub

6. Bahasa Pemrograman (Listing Program) untuk Login Option Explicit Dim CN As New ADODB.Connection Dim RsLogin As New ADODB.Recordset Dim Jlh, D Private Sub cmdC_Click() Set CN = Nothing Set RsLogin = Nothing Unload Me End Sub Private Sub cmdOk_Click() RsLogin.Find "User= '" & cbo & "'", , adSearchForward, adBookmarkFirst If RsLogin.EOF Then MsgBox "Anda tidak boleh menggunakan aplikasi ini" Exit Sub Else If cbo = RsLogin!User And txtP = RsLogin!Pas Then FormUtama.Show Unload Me Else MsgBox "Password Anda Salah" End If End If End Sub


Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.MDB" RsLogin.Open "Login", CN, 1, 3 If RsLogin.RecordCount = 0 Then FormInputUser.Show Unload Me End If For D = 1 To RsLogin.RecordCount cbo.AddItem RsLogin!User RsLogin.MoveNext Next End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsLogin = Nothing Unload Me End Sub

7. Bahasa Pemrograman (Listing Program) untuk Penjualan Option Explicit Dim RsKasir As New ADODB.Recordset Dim RsPenjualan As New ADODB.Recordset Dim RsPersediaan As New ADODB.Recordset Dim RsDataJual As New ADODB.Recordset Dim RSHAPUS As New ADODB.Recordset Dim CN As New ADODB.Connection Dim D, J, NOFAK, GT, Sisa, Pembayaran Dim KdKasir, NmKasir Dim A As Control Private Sub cboKdBrg_Click() RsPersediaan.MoveFirst RsPersediaan.Find "KdBrg='" & cboKdBrg & "'" If RsPersediaan.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Else txtNmBrg = RsPersediaan!NmBrg txtSatuan = RsPersediaan!Satuan txtHJual = 115 / 100 * Val(RsPersediaan!Harga) End If End Sub


Private Sub cboKdBrg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdBrg_Click End Sub Private Sub cboKdKasir_Click() RsKasir.MoveFirst RsKasir.Find "KdKasir='" & cboKdKasir & "'" If RsKasir.EOF Then MsgBox "Data Tidak Ditemukan" Exit Sub Else txtNmKasir = RsKasir!NmKasir End If End Sub Private Sub cboKdKasir_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdKasir_Click End Sub Private Sub cmdBatal_Click() KOSONG txtNoFaktur = NOFAK txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub cmdHapus_Click() If RsDataJual.RecordCount = 0 Then Exit Sub If cboKdBrg = "" Then MsgBox "Anda harus memilih yang akan dihapus" Else 'update tabel stok RsPersediaan!Persediaan = Val(RsPersediaan!Persediaan) + J RsPersediaan.Update GT = GT - Val(txtTHarga) lblGrandTotal = GT 'Hapus Data di Tabel Data Jual RsDataJual.Delete KOSONG End If txtNoFaktur = NOFAK txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub cmdKeluar_Click()


Set CN = Nothing Set RsDataJual = Nothing Set RsPenjualan = Nothing Set RsPersediaan = Nothing Set RsKasir = Nothing Unload Me End Sub Private Sub cmdNext_Click() If RsDataJual.EOF Then cmdNext.Enabled = False RsDataJual.MoveLast Tampil Exit Sub End If RsData Jual.MoveNext cmdPrev.Enabled = True Tampil End Sub Private Sub cmdPrev_Click() If RsDataJual.BOF Then cmdPrev.Enabled = False RsDataJual.MoveFirst Tampil Exit Sub End If RsDataJual.MovePrevious cmdNext.Enabled = True Tampil End Sub Private Sub cmdSimpan_Click() If RsDataJual.RecordCount = 0 Then MsgBox "Belum ada proses penjualan" Exit Sub End If 'Simpan ke tabel Penjualan RsDataJual.MoveFirst Do While RsDataJual.EOF <> True RsPenjualan.AddNew RsPenjualan!NoFaktur = RsDataJual!NoFaktur RsPenjualan!Bulan = RsDataJual!Bulan RsPenjualan!Tanggal = RsDataJual!Tanggal RsPenjualan!NmCustomer = RsDataJual!NmCustomer RsPenjualan!Alamat = RsDataJual!Alamat RsPenjualan!Phone = RsDataJual!Phone


RsPenjualan!KdBrg = RsDataJual!KdBrg RsPenjualan!NmBrg = RsDataJual!NmBrg RsPenjualan!Satuan = RsDataJual!Satuan RsPenjualan!HargaJual = RsDataJual!HargaJual RsPenjualan!JlhJual = RsDataJual!JlhJual RsPenjualan!TotalHarga = RsDataJual!TotalHarga RsPenjualan!KdKasir = RsDataJual!KdKasir RsPenjualan!NmKasir = RsDataJual!NmKasir RsPenjualan.Update RsDataJual.MoveNext Loop lblGrandTotal = "" lblSisaBayar = "" txtPembayaran = "" Set RsDataJual = Nothing RsDataJual.Open "Delete from DataJual", CN, 1, 3 DGPenjualan.Refresh Set DGPenjualan.DataSource = RsDataJual KOSONG RsPenjualan.MoveLast 'txtNoFaktur=val(RsPenjualan!NoFaktur)+1 txtNoFaktur = Format(Val(Left(RsPenjualan!NoFaktur, 4)) + 1, "0000") & "J" txtTgl = Date txtBulan = Format(Date, "MMMM") End Sub Private Sub cmdTambah_Click() Set RsDataJual = Nothing RsDataJual.Open "DataJual", CN, 1, 3 If txtNoFaktur = "" Or cboKdBrg = "" Or txtJlhJual = "" Then MsgBox "Lengkapi data No Faktur, Kode Barang dan Jumlah Jual" Exit Sub End If 'update tabel stok RsPersediaan.Find "KdBrg='" & cboKdBrg & "'", , adSearchForward, adBookmarkFirst RsPersediaan!Persediaan = (RsPersediaan!Persediaan) - J RsPersediaan.Update 'simpan ke tabel datajual RsDataJual.AddNew RsDataJual!NoFaktur = txtNoFaktur RsDataJual!Bulan = txtBulan RsDataJual!Tanggal = txtTgl RsDataJual!NmCustomer = txtNmCustomer RsDataJual!Alamat = txtAlamat RsDataJual!Phone = txtPhone RsDataJual!KdBrg = cboKdBrg


RsDataJual!NmBrg = txtNmBrg RsDataJual!Satuan = txtSatuan RsDataJual!HargaJual = Val(txtHJual) RsDataJual!JlhJual = Val(txtJlhJual) RsDataJual!TotalHarga = txtTHarga RsDataJual!KdKasir = cboKdKasir RsDataJual!NmKasir = txtNmKasir RsDataJual.Update GT = GT + Val(txtTHarga) lblGrandTotal = GT NOFAK = txtNoFaktur KdKasir = cboKdKasir NmKasir = txtNmKasir KOSONG txtNoFaktur = NOFAK txtTgl = Date txtBulan = Format(Date, "MMMM") cboKdKasir = KdKasir txtNmKasir = NmKasir Set DGPenjualan.DataSource = RsDataJual cmdNext.Enabled = True cmdPrev.Enabled = True End Sub

Private Sub DGPenjualan_Click() Tampil End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.mdb" RsPenjualan.Open "Penjualan", CN, 1, 3 RsPersediaan.Open "Persediaan", CN, 1, 3 RsDataJual.Open "DataJual", CN, 1, 3 RsKasir.Open "Kasir", CN, 1, 3 For D = 1 To RsKasir.RecordCount cboKdKasir.AddItem RsKasir!KdKasir RsKasir.MoveNext Next For D = 1 To RsPersediaan.RecordCount cboKdBrg.AddItem RsPersediaan!KdBrg RsPersediaan.MoveNext Next txtTgl = Date txtBulan = Format(Date, "MMMM") Set DGPenjualan.DataSource = RsDataJual


If RsPenjualan.RecordCount = 0 Then txtNoFaktur = "0001" & "-J" Else RsPenjualan.MoveLast txtNoFaktur = Format(Val(Left(RsPenjualan!NoFaktur, 4)) + 1, "0000") & "J" End If cmdNext.Enabled = False cmdPrev.Enabled = False Sisa = 0 Pembayaran = 0 GT = 0 lblGrandTotal = "" lblSisaBayar = "" txtPembayaran = "" End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsDataJual = Nothing Set RsPenjualan = Nothing Set RsPersediaan = Nothing Unload Me End Sub Private Sub txtJlhJual_Change() If IsNumeric(txtJlhJual) = False Then Exit Sub RsPersediaan.MoveFirst RsPersediaan.Find "KdBrg='" & cboKdBrg & "'" J = Val(txtJlhJual) If J < 0 Then MsgBox "Ketik jumlah jual dengan benar" Exit Sub End If If J > Val(RsPersediaan!Persediaan) Then MsgBox "Persediaan Barang Tidak Mencukupi" txtJlhJual = "" txtTHarga = "" Exit Sub End If txtTHarga = Val(txtJlhJual) * Val(txtHJual) End Sub Public Sub KOSONG() For Each A In Me If TypeOf A Is TextBox Then A = "" End If


Next For Each A In Me If TypeOf A Is ComboBox Then A = "" Next End Sub Public Sub Tampil() On Error Resume Next txtNoFaktur = RsDataJual!NoFaktur txtBulan = RsDataJual!Bulan txtTgl = RsDataJual!Tanggal txtNmCustomer = RsDataJual!NmCustomer txtAlamat = RsDataJual!Alamat txtPhone = RsDataJual!Phone cboKdBrg = RsDataJual!KdBrg txtNmBrg = RsDataJual!NmBrg txtSatuan = RsDataJual!Satuan txtHJual = RsDataJual!HargaJual txtJlhJual = RsDataJual!JlhJual txtTHarga = RsDataJual!TotalHarga cboKdKasir = RsDataJual!KdKasir txtNmKasir = RsDataJual!NmKasir End Sub Private Sub txtPembayaran_Change() If IsNumeric(txtPembayaran) = False Then Exit Sub End If Pembayaran = Val(txtPembayaran) GT = Val(lblGrandTotal) Sisa = Pembayaran - GT lblSisaBayar = Sisa End Sub Private Sub txtPembayaran_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If Sisa < 0 Then MsgBox "Uang anda kurang" txtPembayaran = "" txtPembayaran.SetFocus lblSisaBayar = Sisa Exit Sub End If If MsgBox("Apakah akan mencetak bill pembayaran?", vbYesNo) = vbYes Then Cetak cmdSimpan_Click End If


End If End Sub Public Sub Cetak() Dim mw As New Word.Application Dim E, T E = Chr(13) T = Chr(9) Set mw = New Word.Application mw.Documents.Add mw.Selection.Font.Name = "Calibri" mw.Selection.Font.Size = 22 mw.Selection.Font.Underline = wdUnderlineNone mw.Selection.Font.Color = wdColorBlue mw.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter mw.Selection.Font.Bold = True mw.Selection.TypeText "Lintas Graha Computer" & E & E mw.Selection.Font.Name = "Maiandra GD" mw.Selection.Font.Size = 12 mw.Selection.Font.Underline = wdUnderlineSingle mw.Selection.Font.Color = wdColorBlack mw.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft mw.Selection.Font.Bold = False mw.Selection.TypeText "Transaksi Pembayaran" & E mw.Selection.Font.Name = "Maiandra GD" mw.Selection.Font.Size = 12 mw.Selection.Font.Underline = wdUnderlineNone mw.Selection.Font.Color = wdColorBlack mw.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft mw.Selection.Font.Bold = False mw.Selection.TypeText "JlhJual" & T & "Nama Brg" & T & T & T & T & "Total" & E mw.Selection.Font.Name = "Maiandra GD" mw.Selection.Font.Size = 12 mw.Selection.Font.Underline = wdUnderlineNone mw.Selection.Font.Color = wdColorBlack mw.Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft mw.Selection.Font.Bold = False RsDataJual.MoveFirst Do While RsDataJual.EOF <> True mw.Selection.TypeText RsDataJual!JlhJual & T & T & RsDataJual!NmBrg & T & T & T & T & RsDataJual!TotalHarga & E RsDataJual.MoveNext Loop mw.Selection.TypeText "" & E & E mw.Selection.TypeText "Grand Total" & T & T & " : " & lblGrandTotal & E mw.Selection.TypeText "Jumlah Pembayaran" & T & " : " & txtPembayaran &E


mw.Selection.TypeText "Sisa Pembayaran" & T & " : " & lblSisaBayar mw.Visible = True End Sub

8. Bahasa Pemrograman (Listing Program) untuk Laporan Persediaan Option Explicit Dim CN As New ADODB.Connection Dim RsPersediaan As New ADODB.Recordset Dim D Private Sub cboKdBrg_Click() Set RsPersediaan = Nothing RsPersediaan.Open "Persediaan", CN, 1, 3 RsPersediaan.Find "KdBrg='" & cboKdBrg & "'", , adSearchForward, adBookmarkFirst If RsPersediaan.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Else txtNmBrg = RsPersediaan!NmBrg End If End Sub Private Sub cboKdBrg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdBrg_Click End Sub Private Sub cmdCPK_Click() If cboKdBrg = "" Then MsgBox "Pilih salah satu kode barang yang akan di cetak" Exit Sub End If crk.ReportFileName = App.Path & "\Persediaan.rpt" crk.RetrieveDataFiles crk.ReplaceSelectionFormula "{Persediaan.KdBrg}='" & cboKdBrg & "'" crk.PrintReport End Sub Private Sub cmdCS_Click() crs.ReportFileName = App.Path & "\Persediaan.rpt" crs.RetrieveDataFiles crs.PrintReport End Sub Private Sub cmdK_Click() Set CN = Nothing


Set RsPersediaan = Nothing Unload Me End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.mdb" RsPersediaan.Open "Select Distinct KdBrg from Persediaan", CN, 1, 3 For D = 1 To RsPersediaan.RecordCount cboKdBrg.AddItem RsPersediaan!KdBrg RsPersediaan.MoveNext Next End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsPersediaan = Nothing Unload Me End Sub

9. Bahasa Pemrograman (Listing Program) untuk Laporan Barang Masuk Option Explicit Dim CN As New ADODB.Connection Dim RsBrgMasuk As New ADODB.Recordset Dim D Private Sub cboKdBrg_Click() Set RsBrgMasuk = Nothing RsBrgMasuk.Open "BarangMasuk", CN, 1, 3 RsBrgMasuk.Find "KdBrg='" & cboKdBrg & "'", , adSearchForward, adBookmarkFirst If RsBrgMasuk.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Else txtNmBrg = RsBrgMasuk!NmBrg End If End Sub Private Sub cboKdBrg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdBrg_Click End Sub Private Sub cmdCPB_Click() If cboBulan = "" Then


MsgBox "Pilih bulan yang akan di cetak" Exit Sub End If crk.ReportFileName = App.Path & "\BarangMasuk.rpt" crk.RetrieveDataFiles crk.ReplaceSelectionFormula "{BarangMasuk.Bulan}='" & cboBulan & "'" crk.PrintReport End Sub Private Sub cmdCPK_Click() If cboKdBrg = "" Then MsgBox "Pilih salah satu kode barang yang akan di cetak" Exit Sub End If crk.ReportFileName = App.Path & "\BarangMasuk.rpt" crk.RetrieveDataFiles crk.ReplaceSelectionFormula "{BarangMasuk.KdBrg}='" & cboKdBrg & "'" crk.PrintReport End Sub Private Sub cmdCS_Click() crs.ReportFileName = App.Path & "\BarangMasuk.rpt" crs.RetrieveDataFiles crs.PrintReport End Sub Private Sub cmdK_Click() Set CN = Nothing Set RsBrgMasuk = Nothing Unload Me End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.mdb" Set RsBrgMasuk = Nothing RsBrgMasuk.Open "Select Distinct Bulan from BarangMasuk", CN, 1, 3 For D = 1 To RsBrgMasuk.RecordCount cboBulan.AddItem RsBrgMasuk!Bulan RsBrgMasuk.MoveNext Next Set RsBrgMasuk = Nothing RsBrgMasuk.Open "Select Distinct KdBrg from BarangMasuk", CN, 1, 3 For D = 1 To RsBrgMasuk.RecordCount cboKdBrg.AddItem RsBrgMasuk!KdBrg RsBrgMasuk.MoveNext Next


End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsBrgMasuk = Nothing Unload Me End Sub

10. Bahasa Pemrograman (Listing Program) untuk Laporan Penjualan Option Explicit Dim CN As New ADODB.Connection Dim RsPenjualan As New ADODB.Recordset Dim D Private Sub cboKdBrg_Click() Set RsPenjualan = Nothing RsPenjualan.Open "Penjualan", CN, 1, 3 RsPenjualan.Find "KdBrg='" & cboKdBrg & "'", , adSearchForward, adBookmarkFirst If RsPenjualan.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Else txtNmBrg = RsPenjualan!NmBrg End If End Sub Private Sub cboKdBrg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboKdBrg_Click End Sub Private Sub cmdCPB_Click() If cboBulan = "" Then MsgBox "Pilih bulan yang akan di cetak" Exit Sub End If crk.ReportFileName = App.Path & "\Penjualan.rpt" crk.RetrieveDataFiles crk.ReplaceSelectionFormula "{Penjualan.Bulan}='" & cboBulan & "'" crk.PrintReport End Sub Private Sub cmdCPK_Click() If cboKdBrg = "" Then MsgBox "Pilih salah satu kode barang yang akan di cetak" Exit Sub


End If crk.ReportFileName = App.Path & "\Penjualan.rpt" crk.RetrieveDataFiles crk.ReplaceSelectionFormula "{Penjualan.KdBrg}='" & cboKdBrg & "'" crk.PrintReport End Sub Private Sub cmdCS_Click() crs.ReportFileName = App.Path & "\Penjualan.rpt" crs.RetrieveDataFiles crs.PrintReport End Sub Private Sub cmdK_Click() Set CN = Nothing Set RsPenjualan = Nothing Unload Me End Sub Private Sub Form_Load() CN.CursorLocation = adUseClient CN.Open "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & App.Path & "\Lintas Graha Computer.mdb" Set RsPenjualan = Nothing RsPenjualan.Open "Select Distinct Bulan from Penjualan", CN, 1, 3 For D = 1 To RsPenjualan.RecordCount cboBulan.AddItem RsPenjualan!Bulan RsPenjualan.MoveNext Next Set RsPenjualan = Nothing RsPenjualan.Open "Select Distinct KdBrg from Penjualan", CN, 1, 3 For D = 1 To RsPenjualan.RecordCount cboKdBrg.AddItem RsPenjualan!KdBrg RsPenjualan.MoveNext Next End Sub Private Sub Form_Unload(Cancel As Integer) Set CN = Nothing Set RsPenjualan = Nothing Unload Me End Sub


KEMENTERIAN PENDIDIKAN NASIONAL

UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM Jl. Bioteknologi No. 1 Kampus USU Telp. (061) 8214290, 8211212, 8211414 Fax. (061) 8214290 Medan 20155

Kartu Bimbingan Tugas Akhir Mahasiswa

Nama

: MUHAMMAD RIZKI

Nomor Induk Mahasiswa

: 102406145

Judul Tugas Akhir

: APLIKASI PENJUALAN DAN PERSEDIAAN KOMPUTER PADA LINTAS GRAHA COMPUTER MENGGUNAKAN MICROSOFT VISUAL BASIC 6

Dosen Pembimbing

: Drs. Pengarapen Bangun,M.Si.

Tanggal Mulai Bimbingan

: ................................

Tanggal Selesai Bimbingan : ................................. No

Tanggal Asistensi Bimbingan

Pembahasan Pada Asistensi Mengenai, Pada Bab :

1

Pengajuan Proposal

2

Bab 1

3

Bab 2

4

Bab 3

5

Bab 4

6

Bab 5

7

Bab 6

Paraf Dosen Pembimbing

Keterangan

*Kartu ini harap dikembalikan ke Departemen Matematika bila bimbingan mahasiswa telah selesai

Diketahui, Departemen Matematika FMIPA USU Ketua

Disetujui, Pembimbing Utama/ Penanggung Jawab

Prof.Drs.Tulus, M.Si NIP. 196209011988031002

Drs. Pengarapen Bangun,M.Si. NIP. 195608151985031005


SURAT KETERANGAN Hasil Uji Program Tugas Akhir

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

Nama

: MUHAMMAD RIZKI

NIM

: 102406145

Prog. Studi

: DIPLOMA 3 TEKNIK INFORMATIKA

Judul Tugas Akhir : APLIKASI PENJUALAN DAN PERSEDIAAN KOMPUTER PADA LINTAS GRAHA COMPUTER MENGGUNAKAN MICROSOFT VISUAL BASIC 6.0 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,

2013

Dosen Pembimbing/Kepala Lab. Komputer Program Studi D3 Teknik Informatika,

Drs. Pengarapen Bangun,M.Si. NIP. 195608151985031005


BAHASA PEMROGRAMAN (LISTING PROGRAM)

Recommend Documents