LISTING PROGRAM
Kode Program Menu Input Private Sub Form_Activate() WarnaTidakNormal End Sub Private Sub cmdPrevious_Click() On Error Resume Next With rsBarang .MovePrevious If .BOF Then .MoveFirst End If TampilkanData End With End Sub Private Sub cmdTambah_Click() On Error GoTo HandleError If cmdTambah.Caption = "&Tambah" Then WarnaNormal txtKodeBarang.SetFocus NonAktifkanKontrol cmdTambah.Caption = "&Batal" cmdSimpan.Enabled = True txtKodeBarang.Locked = False BersihkanText Else rsBarang.CancelUpdate txtKodeBarang.Locked = True AktifkanTombol cmdTambah.Caption = "&Tambah" cmdSimpan.Enabled = False rsBarang.MoveLast BersihkanText End If cmdTambah_Click_Exit: Exit Sub HandleError: MsgBox "Proses tidak bisa dikerjakan.", vbInformation, "Perhatian" On Error GoTo 0 End Sub
Universitas Sumatera Utara
Private Sub BersihkanText() txtKodeBarang.Text = "" txtNamaBarang.Text = "" txtSatuan.Text = "" txtHargaBeli.Text = "" txtHargaJual.Text = "" txtJumlahBarang.Text = "" End Sub Private Sub cmdHapus_Click() On Error GoTo HandleError With rsBarang .Delete .Requery If .EOF Then MsgBox "Data Kosong.", vbInformation, "Perhatian" NonAktifkanKontrol End If BersihkanText End With cmdHapus_Click_Exit: Exit Sub HandleError: MsgBox "Data tidak dapat diproses.", vbInformation, "Perhatian" On Error GoTo 0 End Sub Private Sub cmdSimpan_Click() On Error GoTo HandIeErrors With rsBarang .AddNew ![Kode Barang] = txtKodeBarang.Text ![Nama Barang] = txtNamaBarang.Text ![Satuan] = txtSatuan.Text ![Harga Beli] = txtHargaBeli.Text ![Harga Jual] = txtHargaJual.Text ![Jumlah Barang] = txtJumlahBarang.Text .Update End With txtKodeBarang.Locked = True AktifkanTombol cmdSimpan.Enabled = False cmdTambah.Caption = "&Tambah" rsBarang.MoveFirst rsBarang.MoveLast
Universitas Sumatera Utara
cmdSimpan_Click_Exit: Exit Sub HandIeErrors: Dim strMessage As String Dim errDBError As ADODB.Error For Each errDBError In conAVB.Errors strMessage = strMessage & errDBError.Description & vbCrLf Next MsgBox strMessage, vbExclamation, " Data Kembar" On Error GoTo 0 End Sub Private Sub NonAktifkanKontrol() cmdNext.Enabled = False cmdPrevious.Enabled = False cmdFirst.Enabled = False cmdLast.Enabled = False cmdHapus.Enabled = False End Sub Private Sub AktifkanTombol() cmdNext.Enabled = True cmdPrevious.Enabled = True cmdFirst.Enabled = True cmdLast.Enabled = True cmdHapus.Enabled = True End Sub Private Sub cmdFirst_Click() On Error Resume Next rsBarang.MoveFirst TampilkanData End Sub Private Sub cmdLast_Click() On Error Resume Next rsBarang.MoveLast TampilkanData End Sub Private Sub cmdNext_Click() On Error Resume Next With rsBarang .MoveNext If .EOF Then .MoveLast End If End With
Universitas Sumatera Utara
TampilkanData End Sub Private Sub cmdTutup_Click() Unload Me End Sub Private Sub Form_Load() Dim strSQL As String Set conAVB = New ADODB.Connection conAVB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Persist Security info=False;Data source =" & App.Path & _ "\AVB.mdb;mode = readwrite" conAVB.Open Set rsBarang = New ADODB.Recordset strSQL = "SELECT * FROM Barang" rsBarang.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText End Sub Private Sub mnu_kluar_Click() Unload Me End Sub Private Sub txtKodeBarang_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtNamaBarang.SetFocus End If End Sub Private Sub txtNamaBarang_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtSatuan.SetFocus End If End Sub Private Sub TxtSatuan_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtHargaBeli.SetFocus End If End Sub Private Sub txtHargaBeli_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii <= Asc("-") Or KeyAscii = vbKeyBack) Then Beep
Universitas Sumatera Utara
KeyAscii = 0 End If If KeyAscii = 13 Then txtHargaJual.SetFocus End If End Sub Private Sub txtHargaJual_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii <= Asc("-") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 End If If KeyAscii = 13 Then txtJumlahBarang.SetFocus End If End Sub Private Sub txtJumlahBarang_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii <= Asc("-") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 End If If KeyAscii = 13 Then cmdSimpan.SetFocus End If End Sub Private Sub TampilkanData() With rsBarang txtKodeBarang.Text = ![Kode Barang] txtNamaBarang.Text = ![Nama Barang] txtSatuan.Text = ![Satuan] txtHargaBeli.Text = ![Harga Beli] txtHargaJual.Text = ![Harga Jual] txtJumlahBarang.Text = ![Jumlah Barang] End With End Sub Sub WarnaNormal() txtKodeBarang.BackColor = vbWhite txtNamaBarang.BackColor = vbWhite txtSatuan.BackColor = vbWhite txtHargaBeli.BackColor = vbWhite txtHargaJual.BackColor = vbWhite txtJumlahBarang.BackColor = vbWhite txtKodeBarang.Enabled = True txtNamaBarang.Enabled = True txtSatuan.Enabled = True txtHargaBeli.Enabled = True txtHargaJual.Enabled = True
Universitas Sumatera Utara
txtJumlahBarang.Enabled = True End Sub Sub WarnaTidakNormal() txtKodeBarang.BackColor = vbButtonFace txtNamaBarang.BackColor = vbButtonFace txtSatuan.BackColor = vbButtonFace txtHargaBeli.BackColor = vbButtonFace txtHargaJual.BackColor = vbButtonFace txtJumlahBarang.BackColor = vbButtonFace txtKodeBarang.Enabled = False txtNamaBarang.Enabled = False txtSatuan.Enabled = False txtHargaBeli.Enabled = False txtHargaJual.Enabled = False txtJumlahBarang.Enabled = False End Sub
Universitas Sumatera Utara
Kode Program Edit Option Explicit Dim conAVB As ADODB.Connection Dim rsBarang As ADODB.Recordset Private Sub cboBarang_Click() Dim strBarang As String Dim vntBookMark As Variant strBarang = "[Kode Barang] = '" & cboBarang & "'" With rsBarang .MoveFirst .Find strBarang txtNamaBarang.Text = ![Nama Barang] txtSatuan.Text = ![Satuan] txtHargaBeli.Text = ![Harga Beli] txtHargaJual.Text = ![Harga Jual] txtJumlahBarang.Text = ![Jumlah Barang] End With txtNamaBarang.Enabled = True txtSatuan.Enabled = True txtHargaBeli.Enabled = True txtHargaJual.Enabled = True txtJumlahBarang.Enabled = True cmdEdit.Enabled = True End Sub Private Sub cmdEdit_Click() On Error GoTo HandleErrors With rsBarang ![Kode Barang] = cboBarang.Text ![Nama Barang] = txtNamaBarang.Text ![Satuan] = txtSatuan.Text ![Harga Beli] = txtHargaBeli.Text ![Harga Jual] = txtHargaJual.Text ![Jumlah Barang] = txtJumlahBarang.Text .Update End With cmdEdit.Enabled = False txtNamaBarang.Enabled = False txtSatuan.Enabled = False txtHargaBeli.Enabled = False txtHargaJual.Enabled = False txtJumlahBarang.Enabled = False With rsBarang While Not .EOF If Not .BOF Then cboBarang.Clear
Universitas Sumatera Utara
.MoveNext End If Wend End With With rsBarang .MoveFirst While Not .EOF If Not .BOF Then cboBarang.AddItem ![Kode Barang] .MoveNext End If Wend End With cmdEdit_Click_Exit: Exit Sub HandleErrors: Dim strMessage As String Dim errDBError As ADODB.Error For Each errDBError In conAVB.Errors strMessage = strMessage & errDBError.Description & vbCrLf Next MsgBox strMessage, vbExclamation, "Provider Error" On Error GoTo 0 End Sub Private Sub cmdTutup_Click() Unload Me End Sub Private Sub Form_Load() Dim strSQL As String Set conAVB = New ADODB.Connection conAVB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Persist Security info=False;Data source =" & App.Path & _ "\AVB.mdb;mode = readwrite" conAVB.Open Set rsBarang = New ADODB.Recordset strSQL = "SELECT * FROM Barang" rsBarang.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText On Error GoTo 0 With rsBarang While Not .EOF If Not rsBarang.BOF Then cboBarang.AddItem ![Kode Barang]
Universitas Sumatera Utara
.MoveNext End If Wend End With End Sub Private Sub Keluar_Click() Unload Me End Sub Private Sub txtNamaBarang_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub
Universitas Sumatera Utara
Kode Program Transaksi Option Explicit Dim conAVB As ADODB.Connection Dim rsPelanggan As ADODB.Recordset Dim rsPenjualan As ADODB.Recordset Dim rsBarang As ADODB.Recordset Dim Nilai As Integer Private Sub cboPelanggan_Click() Dim strSearch As String Dim vntBookMark As Variant strSearch = "[Kode Pelanggan] = '" & cboPelanggan & "'" With rsPelanggan .MoveFirst .Find strSearch txtNamaPelanggan.Text = ![Nama Pelanggan] End With cboBarang.SetFocus End Sub Private Sub cmdTambah_Click() On Error GoTo HandleError If cmdTambah.Caption = "&Tambah" Then txtNoBon.Locked = False txtNoBon.SetFocus txtTanggalBon.Text = Format(Now, "dd-mm-yyyy") NonAktifkanKontrol cmdTambah.Caption = "&Batal" cmdSimpan.Enabled = True BersihText Else rsPenjualan.CancelUpdate AktifkanTombol cmdTambah.Caption = "&Tambah" cmdSimpan.Enabled = False rsPenjualan.MoveLast BersihText End If cmdTambah_Click_Exit: Exit Sub HandleError: MsgBox "Proses tidak bisa dikerjakan.", vbInformation, "Perhatian" On Error GoTo 0 End Sub
Universitas Sumatera Utara
Private Sub cmdHapus_Click() On Error GoTo HandleError cboBarang_Click Dim NILAi2 As Integer NILAi2 = Nilai + Val(txtBanyaknyaBarang.Text) With rsPenjualan .Delete .Requery If .EOF Then MsgBox "Data Kosong.", vbInformation, "Perhatian" NonAktifkanKontrol End If End With With rsBarang ![Jumlah Barang] = NILAi2 .Update .Requery End With BersihText cmdHapus_Click_Exit: Exit Sub HandleError: MsgBox "Data tidak dapat diproses.", vbInformation, "Perhatian" On Error GoTo 0 End Sub Private Sub cmdSimpan_Click() cboBarang_Click Dim NILAI1 As Integer NILAI1 = Nilai - Val(txtBanyaknyaBarang.Text) With rsBarang ![Jumlah Barang] = NILAI1 .Update .Requery End With With rsPenjualan .AddNew ![No Bon] = txtNoBon.Text ![Tanggal Bon] = txtTanggalBon.Text ![Kode Pelanggan] = cboPelanggan.Text ![Nama Pelanggan] = txtNamaPelanggan.Text ![Kode Barang] = cboBarang.Text ![Nama Barang] = txtNamaBarang.Text ![Satuan] = txtSatuan.Text ![Harga Jual] = txtHargaBarang.Text ![Banyak] = txtBanyaknyaBarang.Text
Universitas Sumatera Utara
![Jumlah Uang] Adodc1.Refresh .Update .Requery End With txtNoBon.Locked = AktifkanTombol cmdSimpan.Enabled cmdTambah.Caption
= txtJumlah.Text
True = False = "&Tambah"
cmdSimpan_Click_Exit: Exit Sub HandleErrors: Dim strMessage As String Dim errDBError As ADODB.Error For Each errDBError In conAVB.Errors strMessage = strMessage & errDBError.Description & vbCrLf Next MsgBox strMessage, vbExclamation, "Data Kembar" On Error GoTo 0 End Sub Private Sub NonAktifkanKontrol() cmdNext.Enabled = False cmdPrevious.Enabled = False cmdFirst.Enabled = False cmdLast.Enabled = False cmdHapus.Enabled = False End Sub Private Sub AktifkanTombol() cmdNext.Enabled = True cmdPrevious.Enabled = True cmdFirst.Enabled = True cmdLast.Enabled = True cmdHapus.Enabled = True End Sub Private Sub cmdFirst_Click() On Error Resume Next rsPenjualan.MoveFirst TampilkanData End Sub Private Sub cmdLast_Click() On Error Resume Next rsPenjualan.MoveLast TampilkanData
Universitas Sumatera Utara
End Sub Private Sub cmdNext_Click() On Error Resume Next With rsPenjualan .MoveNext If .EOF Then .MoveLast End If TampilkanData End With End Sub Private Sub cmdPrevious_Click() On Error Resume Next With rsPenjualan .MovePrevious If .BOF Then .MoveFirst End If TampilkanData End With End Sub Private Sub cmdTutup_Click() Unload Me End Sub Private Sub cboBarang_Click() Dim strSearch As String Dim vntBookMark As Variant strSearch = "[Kode Barang] = '" & cboBarang & "'" With rsBarang .MoveFirst .Find strSearch txtHargaBarang.Text = ![Harga Jual] txtNamaBarang.Text = ![Nama Barang] txtSatuan.Text = ![Satuan] Nilai = ![Jumlah Barang] End With txtBanyaknyaBarang.SetFocus End Sub Private Sub Form_Load() Dim strSQL As String Set conAVB = New ADODB.Connection conAVB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
Universitas Sumatera Utara
"Persist Security info=False;Data source =" & App.Path & _ "\AVB.mdb;mode = readwrite" conAVB.Open Set rsBarang = New ADODB.Recordset strSQL = "SELECT * FROM Barang" rsBarang.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText Set rsPelanggan = New ADODB.Recordset strSQL = "SELECT * FROM Pelanggan" rsPelanggan.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText Set rsPenjualan = New ADODB.Recordset strSQL = "SELECT * FROM TabelJual" rsPenjualan.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText With rsPelanggan While Not .EOF If Not .BOF Then cboPelanggan.AddItem ![Kode Pelanggan] .MoveNext End If Wend End With With rsBarang While Not .EOF If Not .BOF Then cboBarang.AddItem ![Kode Barang] .MoveNext End If Wend End With End Sub Private Sub Keluar_Click() Unload Me End Sub Private Sub Timer1_Timer() lblJam = DateValue(Now) lblTime = TimeValue(Now) End Sub Private Sub txtBanyaknyaBarang_KeyPress(KeyAscii As Integer)
Universitas Sumatera Utara
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 End If End Sub Private Sub txtHargaBarang_Change() Dim Jumlah As Single Jumlah = Val(txtHargaBarang.Text) * Val(txtBanyaknyaBarang.Text) On Error GoTo Salah txtJumlah.Text = Format(Jumlah, "Rp ###,###,###") & "," Exit Sub Salah: End Sub Private Sub txtBanyaknyaBarang_Change() Dim Jumlah As Single Jumlah = Val(txtHargaBarang.Text) * Val(txtBanyaknyaBarang.Text) On Error GoTo Salah txtJumlah.Text = Format(Jumlah, "Rp ###,###,###") & "," On Error GoTo 0 Exit Sub Salah: End Sub Private Sub txtHargaBarang_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 End If End Sub Private Sub txtNoBon_KeyPress(KeyAscii As Integer) If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii <= Asc("-") Or KeyAscii = vbKeyBack) Then Beep KeyAscii = 0 End If If KeyAscii = 13 Then txtTanggalBon.SetFocus End If End Sub
Universitas Sumatera Utara
Private Sub txtTanggalBon_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboPelanggan.SetFocus End If End Sub Private Sub TampilkanData2() With rsBarang txtKode.Text = ![Kode Barang] txtNama.Text = ![Nama Barang] txtSatu.Text = ![Satuan] txtStok.Text = ![Jumlah Barang] End With End Sub Private Sub TampilkanData() With rsPenjualan txtNoBon.Text = ![No Bon] txtTanggalBon.Text = ![Tanggal Bon] cboPelanggan.Text = ![Kode Pelanggan] txtNamaPelanggan.Text = ![Nama Pelanggan] cboBarang.Text = ![Kode Barang] txtNamaBarang.Text = ![Nama Barang] txtSatuan.Text = ![Satuan] txtHargaBarang.Text = ![Harga Jual] txtBanyaknyaBarang.Text = ![Banyak] txtJumlah.Text = ![Jumlah] End With End Sub Private Sub BersihText() With rsPenjualan txtNoBon.Text = "" cboPelanggan.Text = "" txtNamaPelanggan.Text = "" cboBarang.Text = "" txtNamaBarang.Text = "" txtSatuan.Text = "" txtHargaBarang.Text = "" txtBanyaknyaBarang.Text = "" txtJumlah.Text = "" End With End Sub
Universitas Sumatera Utara
SURAT KETERANGAN Hasil Uji Program Tugas Akhir
Yang bertanda tangan di bawah ini, menerangkan bahwa mahasiswa Tugas Akhir program D3 Teknik Informatika :
Nama Mahasiswa
: HERU KURNIAWAN
Nomor Induk Mahasiswa
: 112406181
Program Studi
: D3 TEKNIK INFORMATIKA
Judul Tugas Akhir
: SISTIM INFORMASI PERSEDIAAN BAHAN BANGUNAN PADA PL. HANS JAYA DENGAN MENGGUNAKAN MICROSOFT VISUAL BASIC 6.0.
Telah melaksanakan tes program Tugas Akhir mahasiswa tersebut di atas pada tanggal:
Juni 2014
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,
Juni 2014
Dosen Pembimbing Program Studi D3 Teknik Informatika
Drs. Faigiziduhu Bu'ulolo, M.Si NIP. 19531218 198003 1 003
Universitas Sumatera Utara
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 Mahasiswa
: Heru Kurniawan
Nomor Induk Mahasiswa
: 112406181
Program Studi
: D3 Teknik Informatika
Judul
: Sistem Informasi Persediaan Bahan Bangunan Pada PL. Hans Jaya Dengan Menggunakan Microsoft Visual Basic 6.0
Dosen Pembimbing
: Drs. Faigiziduhu Bu'ulolo, M.Si
Tanggal Mulai Bimbingan
:
Maret 2014
Tanggal Selesai Bimbingan
:
Juni 2014
No
Tanggal Bimbingan
Pembahasan Asistensi Mengenai Bab
Paraf Dosen Pembimbing
Keterangan
1 2 3 4 5 6 7 * Kartu ini harap dikembalikan ke Departemen Matematika bila bimbingan Mahasiswa telah selesai
Diketahui Program Studi D3 Teknik Informatika FMIPA USU Ketua,
Disetujui, Pembimbing Utama/ Penanggung Jawab
Dr. Elly Rosmaini, M.Si NIP. 19600520 198503 2 002
Drs. Faigiziduhu Bu'ulolo, M.Si NIP. 19531218 198003 1 003
Universitas Sumatera Utara