Program Data Barang
1. Cari Barang
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsBarang As ADODB.Recordset
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_cari_barang_Click()
On Error Resume Next
Dim strKode, strCari As String
strKode = InputBox("Masukkan Kode Barang Yang Akan anda Cari.", "Cari Data Barang")
strCari = "[Kode Barang] = '" & strKode & "'"
With rsBarang
.MoveFirst
.Find strCari
If .EOF Then MsgBox "Kode Tidak Ada", vbExclamation, "Perhatian"
TampilkanData
End With
End Sub
Private Sub mnu_kluar_Click()
Unload Me
End Sub
Private Sub TampilkanData()
With rsBarang
txtKodeBarang.Text = ![Kode Barang]
txtNamaBarang.Text = ![Nama Barang]
txtHargaBarang.Text = ![Harga Barang]
txtJumlahBarang.Text = ![Jumlah Barang]
End With
End Sub
2. Program Data Barang
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsBarang As ADODB.Recordset
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
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
Private Sub BersihkanText()
txtKodeBarang.Text = ""
txtNamaBarang.Text = ""
txtHargaBarang.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
![Harga Barang] = txtHargaBarang.Text
![Jumlah Barang] = txtJumlahBarang.Text
.Update
End With
txtKodeBarang.Locked = True
AktifkanTombol
cmdSimpan.Enabled = False
cmdTambah.Caption = "&Tambah"
rsBarang.MoveFirst
rsBarang.MoveLast
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
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
txtHargaBarang.SetFocus
End If
End Sub
Private Sub txtHargaBarang_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]
txtHargaBarang.Text = ![Harga Barang]
txtJumlahBarang.Text = ![Jumlah Barang]
End With
End Sub
3. Program Data Pelanggan
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsPelanggan As ADODB.Recordset
Private Sub cmdPrevious_Click()
On Error Resume Next
With rsPelanggan
.MovePrevious
If .BOF Then
.MoveFirst
End If
TampilkanData
End With
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 rsPelanggan = New ADODB.Recordset
strSQL = "SELECT * FROM Pelanggan"
rsPelanggan.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText
End Sub
Private Sub cmdTambah_Click()
On Error GoTo HandleError
If cmdTambah.Caption = "&Tambah" Then
WarnaNormal
txtKodePelanggan.SetFocus
NonAktifkanKontrol
cmdTambah.Caption = "&Batal"
cmdSimpan.Enabled = True
txtKodePelanggan.Locked = False
BersihkanText
Else
rsPelanggan.CancelUpdate
txtKodePelanggan.Locked = True
AktifkanTombol
cmdTambah.Caption = "&Tambah"
cmdSimpan.Enabled = False
rsPelanggan.MoveLast
BersihkanText
End If
cmdTambah_Click_Exit:
Exit Sub
HandleError:
MsgBox "Proses tidak bisa dikerjakan.", vbInformation, "Perhatian"
On Error GoTo 0
End Sub
Private Sub cmdHapus_Click()
On Error GoTo HandleError
With rsPelanggan
.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 HandleErrors
With rsPelanggan
.AddNew
![Kode Pelanggan] = txtKodePelanggan.Text
![Nama Pelanggan] = txtNamaPelanggan.Text
![Alamat Pelanggan] = txtAlamatPelanggan.Text
![Telepon Pelanggan] = txtTeleponPelanggan.Text
.Update
End With
txtKodePelanggan.Locked = True
AktifkanTombol
cmdSimpan.Enabled = False
cmdTambah.Caption = "&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
rsPelanggan.MoveFirst
TampilkanData
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
rsPelanggan.MoveLast
TampilkanData
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
With rsPelanggan
.MoveNext
If .EOF Then
.MoveLast
End If
TampilkanData
End With
End Sub
Private Sub cmdTutup_Click()
Unload Me
End Sub
Sub WarnaNormal()
txtNamaPelanggan.BackColor = vbWhite
txtAlamatPelanggan.BackColor = vbWhite
txtKodePelanggan.BackColor = vbWhite
txtTeleponPelanggan.BackColor = vbWhite
txtNamaPelanggan.Enabled = True
txtAlamatPelanggan.Enabled = True
txtKodePelanggan.Enabled = True
txtTeleponPelanggan.Enabled = True
End Sub
Sub WarnaTidakNormal()
txtNamaPelanggan.BackColor = vbButtonFace
txtAlamatPelanggan.BackColor = vbButtonFace
txtKodePelanggan.BackColor = vbButtonFace
txtTeleponPelanggan.BackColor = vbButtonFace
txtNamaPelanggan.Enabled = False
txtAlamatPelanggan.Enabled = False
txtKodePelanggan.Enabled = False
txtTeleponPelanggan.Enabled = False
End Sub
Private Sub Form_Activate()
WarnaTidakNormal
End Sub
Private Sub keluar_Click()
Unload Me
End Sub
Private Sub txtKodePelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtNamaPelanggan.SetFocus
End If
End Sub
Private Sub txtNamaPelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtAlamatPelanggan.SetFocus
End If
End Sub
Private Sub txtAlamatPelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtTeleponPelanggan.SetFocus
End If
End Sub
Private Sub txtTeleponPelanggan_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 BersihkanText()
txtKodePelanggan.Text = ""
txtNamaPelanggan.Text = ""
txtAlamatPelanggan.Text = ""
txtTeleponPelanggan.Text = ""
End Sub
Private Sub TampilkanData()
With rsPelanggan
txtKodePelanggan.Text = ![Kode Pelanggan]
txtNamaPelanggan.Text = ![Nama Pelanggan]
txtAlamatPelanggan.Text = ![Alamat Pelanggan]
txtTeleponPelanggan.Text = ![Telepon Pelanggan]
End With
End Sub
4. Program Data Supplier
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsPemasok As ADODB.Recordset
Private Sub cmdPrevious_Click()
On Error Resume Next
With rsPemasok
.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
txtKodePemasok.SetFocus
NonAktifkanKontrol
cmdTambah.Caption = "&Batal"
cmdSimpan.Enabled = True
txtKodePemasok.Locked = False
BersihkanText
Else
rsPemasok.CancelUpdate
txtKodePemasok.Locked = True
AktifkanTombol
cmdTambah.Caption = "&Tambah"
cmdSimpan.Enabled = False
rsPemasok.MoveLast
BersihkanText
End If
cmdTambah_Click_Exit:
Exit Sub
HandleError:
MsgBox "Proses tidak bisa dikerjakan.", vbInformation, "Perhatian"
On Error GoTo 0
End Sub
Private Sub cmdHapus_Click()
On Error GoTo HandleError
With rsPemasok
.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 HandleErrors
With rsPemasok
.AddNew
![Kode Pemasok] = txtKodePemasok
![Nama Pemasok] = txtNamaPemasok
![Alamat Pemasok] = txtAlamatPemasok
![No Telepon] = txtNoTelepon
.Update
End With
txtKodePemasok.Locked = True
AktifkanTombol
cmdSimpan.Enabled = False
cmdTambah.Caption = "&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/Data Kosong"
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
rsPemasok.MoveFirst
TampilkanData
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
rsPemasok.MoveLast
TampilkanData
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
With rsPemasok
.MoveNext
If .EOF Then
.MoveLast
End If
TampilkanData
End With
End Sub
Private Sub cmdTutup_Click()
Unload Me
End Sub
Sub WarnaNormal()
txtNamaPemasok.BackColor = vbWhite
txtAlamatPemasok.BackColor = vbWhite
txtKodePemasok.BackColor = vbWhite
txtNoTelepon.BackColor = vbWhite
txtNamaPemasok.Enabled = True
txtAlamatPemasok.Enabled = True
txtKodePemasok.Enabled = True
txtNoTelepon.Enabled = True
End Sub
Sub WarnaTidakNormal()
txtNamaPemasok.BackColor = vbButtonFace
txtAlamatPemasok.BackColor = vbButtonFace
txtKodePemasok.BackColor = vbButtonFace
txtNoTelepon.BackColor = vbButtonFace
txtNamaPemasok.Enabled = False
txtAlamatPemasok.Enabled = False
txtKodePemasok.Enabled = False
txtNoTelepon.Enabled = False
End Sub
Private Sub Form_Activate()
WarnaTidakNormal
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 rsPemasok = New ADODB.Recordset
strSQL = "SELECT * FROM Pemasok"
rsPemasok.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText
End Sub
Private Sub kluar_Click()
Unload Me
End Sub
Private Sub txtKodePemasok_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtNamaPemasok.SetFocus
End If
End Sub
Private Sub txtNamaPemasok_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtAlamatPemasok.SetFocus
End If
End Sub
Private Sub txtAlamatPemasok_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
txtNoTelepon.SetFocus
End If
End Sub
Private Sub txtNoTelepon_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 rsPemasok
txtKodePemasok.Text = ![Kode Pemasok]
txtNamaPemasok.Text = ![Nama Pemasok]
txtAlamatPemasok.Text = ![Alamat Pemasok]
txtNoTelepon.Text = ![No Telepon]
End With
End Sub
Private Sub BersihkanText()
txtKodePemasok.Text = ""
txtNamaPemasok.Text = ""
txtAlamatPemasok.Text = ""
txtNoTelepon.Text = ""
End Sub
5. Program Edit Barang
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]
txtHargaBarang.Text = ![Harga Barang]
txtJumlahBarang.Text = ![Jumlah Barang]
End With
txtNamaBarang.Enabled = True
txtHargaBarang.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
![Harga Barang] = txtHargaBarang.Text
![Jumlah Barang] = txtJumlahBarang.Text
.Update
End With
cmdEdit.Enabled = False
txtNamaBarang.Enabled = False
txtHargaBarang.Enabled = False
txtJumlahBarang.Enabled = False
With rsBarang
While Not .EOF
If Not .BOF Then
cboBarang.Clear
.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]
.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
6. Program Edit Pelanggan
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsPelanggan As ADODB.Recordset
Private Sub cmdEdit_Click()
On Error GoTo HandleErrors
With rsPelanggan
![Kode Pelanggan] = txtKodePelanggan.Text
![Nama Pelanggan] = txtNamaPelanggan.Text
![Alamat Pelanggan] = txtAlamatPelanggan.Text
![Telepon Pelanggan] = txtTeleponPelanggan.Text
.Update
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, " Data Kembar"
On Error GoTo 0
End Sub
Private Sub cmdFirst_Click()
On Error Resume Next
rsPelanggan.MoveFirst
TampilkanData
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
rsPelanggan.MoveLast
TampilkanData
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
With rsPelanggan
.MoveNext
If .EOF Then
.MoveLast
End If
TampilkanData
End With
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
With rsPelanggan
.MovePrevious
If .BOF Then
.MoveFirst
End If
TampilkanData
End With
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 rsPelanggan = New ADODB.Recordset
strSQL = "SELECT * FROM Pelanggan"
rsPelanggan.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText
End Sub
Private Sub mnu_keluar_Click()
Unload Me
End Sub
Private Sub txtAlamatPelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtNamaPelanggan_Change()
cmdEdit.Enabled = True
End Sub
Private Sub TampilkanData()
With rsPelanggan
txtKodePelanggan.Text = ![Kode Pelanggan]
txtNamaPelanggan.Text = ![Nama Pelanggan]
txtAlamatPelanggan.Text = ![Alamat Pelanggan]
txtTeleponPelanggan.Text = ![Telepon Pelanggan]
End With
End Sub
Private Sub txtNamaPelanggan_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
7. Program Edit Pemasok
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsPemasok As ADODB.Recordset
Private Sub cboPemasok_Click()
Dim strPemasok As String
Dim vntBookMark As Variant
strPemasok = "[Kode Pemasok] = '" & cboPemasok & "'"
With rsPemasok
.MoveFirst
.Find strPemasok
txtNamaPemasok.Text = ![Nama Pemasok]
txtAlamatPemasok.Text = ![Alamat Pemasok]
txtNoTelepon.Text = ![No Telepon]
End With
txtNamaPemasok.Enabled = True
txtAlamatPemasok.Enabled = True
txtNoTelepon.Enabled = True
cmdEdit.Enabled = True
End Sub
Private Sub cmdEdit_Click()
On Error GoTo HandleErrors
With rsPemasok
![Kode Pemasok] = cboPemasok.Text
![Nama Pemasok] = txtNamaPemasok.Text
![Alamat Pemasok] = txtAlamatPemasok.Text
![No Telepon] = txtNoTelepon.Text
.Update
End With
txtNamaPemasok.Enabled = False
txtAlamatPemasok.Enabled = False
txtNoTelepon.Enabled = False
cmdEdit.Enabled = False
With rsPemasok
While Not .EOF
If Not .BOF Then
cboPemasok.Clear
.MoveNext
End If
Wend
End With
With rsPemasok
.MoveFirst
While Not .EOF
If Not .BOF Then
cboPemasok.AddItem ![Kode Pemasok]
.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, " Data Kembar"
On Error GoTo 0
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 rsPemasok = New ADODB.Recordset
strSQL = "SELECT * FROM Pemasok"
rsPemasok.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText
On Error GoTo 0
With rsPemasok
While Not .EOF
If Not rsPemasok.BOF Then
cboPemasok.AddItem ![Kode Pemasok]
.MoveNext
End If
Wend
End With
End Sub
Private Sub mnu_keluar_Click()
Unload Me
End Sub
Private Sub txtAlamatPemasok_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub txtNamaPemasok_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
8 Program FormBeli
Option Explicit
Dim conAVB As ADODB.Connection
Dim rsPelanggan As ADODB.Recordset
Dim rsPembelian As ADODB.Recordset
Dim rsBarang As ADODB.Recordset
Dim Nilai As Integer
Private Sub cboPelanggan_Click()
cboBarang.SetFocus
End Sub
Private Sub cmdTambah_Click()
On Error GoTo HandleError
If cmdTambah.Caption = "&Tambah" Then
txtNoBon.Locked = False
txtNoBon.SetFocus
NonAktifkanKontrol
cmdTambah.Caption = "&Batal"
cmdSimpan.Enabled = True
BersihText
Else
rsPembelian.CancelUpdate
AktifkanTombol
cmdTambah.Caption = "&Tambah"
cmdSimpan.Enabled = False
rsPembelian.MoveLast
BersihText
End If
cmdTambah_Click_Exit:
Exit Sub
HandleError:
MsgBox "Proses tidak bisa dikerjakan.", vbInformation, "Perhatian"
On Error GoTo 0
End Sub
Private Sub cmdHapus_Click()
On Error GoTo HandleError
cboBarang_Click
Dim NILAi2 As Integer
NILAi2 = Nilai - Val(txtBanyaknyaBarang.Text)
With rsPembelian
.Delete
.Requery
If .EOF Then
MsgBox "Data Kosong.", vbInformation, "Perhatian"
NonAktifkanKontrol
End If
End With
BersihText
With rsBarang
![Jumlah Barang] = NILAi2
.Update
.Requery
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()
cboBarang_Click
Dim NILAI1 As Integer
NILAI1 = Nilai + Val(txtBanyaknyaBarang.Text)
With rsBarang
![Jumlah Barang] = NILAI1
.Update
.Requery
End With
With rsPembelian
.AddNew
![No Bon] = txtNoBon.Text
![Tanggal Bon] = txtTanggalBon.Text
![Kode Pelanggan] = cboPelanggan.Text
![Kode Barang] = cboBarang.Text
![Nama Barang] = txtNamaBarang.Text
![Harga Satuan] = txtHargaBarang.Text
![Banyak] = txtBanyaknyaBarang.Text
![Jumlah Uang] = txtJumlah.Text
.Update
.Requery
End With
txtNoBon.Locked = True
AktifkanTombol
cmdSimpan.Enabled = False
cmdTambah.Caption = "&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
rsPembelian.MoveFirst
TampilkanData
End Sub
Private Sub cmdLast_Click()
On Error Resume Next
rsPembelian.MoveLast
TampilkanData
End Sub
Private Sub cmdNext_Click()
On Error Resume Next
With rsPembelian
.MoveNext
If .EOF Then
.MoveLast
End If
TampilkanData
End With
End Sub
Private Sub cmdPrevious_Click()
On Error Resume Next
With rsPembelian
.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 Barang]
txtNamaBarang.Text = ![Nama Barang]
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;" & _
"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 [Kode Pelanggan] FROM Pelanggan"
rsPelanggan.Open strSQL, conAVB, adOpenDynamic, adLockOptimistic, adCmdText
Set rsPembelian = New ADODB.Recordset
strSQL = "SELECT * FROM TabelBeli"
rsPembelian.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 txtBanyaknyaBarang_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 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
Private Sub txtTanggalBon_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cboPelanggan.SetFocus
End If
End Sub
Private Sub TampilkanData()
With rsPembelian
txtNoBon.Text = ![No Bon]
txtTanggalBon.Text = ![Tanggal Bon]
cboPelanggan.Text = ![Kode Pelanggan]
cboBarang.Text = ![Kode Barang]
txtNamaBarang.Text = ![Nama Barang]
txtHargaBarang.Text = ![Harga Satuan]
txtBanyaknyaBarang.Text = ![Banyak]
txtJumlah.Text = ![Jumlah]
End With
End Sub
Private Sub BersihText()
With rsPembelian
txtNoBon.Text = ""
txtTanggalBon.Text = ""
cboPelanggan.Text = ""
cboBarang.Text = ""
txtNamaBarang.Text = ""
txtHargaBarang.Text = ""
txtBanyaknyaBarang.Text = ""
txtJumlah.Text = ""
End With
End Sub
9. Program FormJual
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()
cboBarang.SetFocus
End Sub
Private Sub cmdTambah_Click()
On Error GoTo HandleError
If cmdTambah.Caption = "&Tambah" Then
txtNoBon.Locked = False
txtNoBon.SetFocus
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
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
![Kode Barang] = cboBarang.Text
![Nama Barang] = txtNamaBarang.Text
![Harga Satuan] = txtHargaBarang.Text
![Banyak] = txtBanyaknyaBarang.Text
![Jumlah Uang] = txtJumlah.Text
.Update
.Requery
End With
txtNoBon.Locked = True
AktifkanTombol
cmdSimpan.Enabled = False
cmdTambah.Caption = "&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
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 Barang]
txtNamaBarang.Text = ![Nama Barang]
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;" & _
"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 [Kode Pelanggan] 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 txtBanyaknyaBarang_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 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
Private Sub txtTanggalBon_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
cboPelanggan.SetFocus
End If
End Sub
Private Sub TampilkanData()
With rsPenjualan
txtNoBon.Text = ![No Bon]
txtTanggalBon.Text = ![Tanggal Bon]
cboPelanggan.Text = ![Kode Pelanggan]
cboBarang.Text = ![Kode Barang]
txtNamaBarang.Text = ![Nama Barang]
txtHargaBarang.Text = ![Harga Satuan]
txtBanyaknyaBarang.Text = ![Banyak]
txtJumlah.Text = ![Jumlah]
End With
End Sub
Private Sub BersihText()
With rsPenjualan
txtNoBon.Text = ""
txtTanggalBon.Text = ""
cboPelanggan.Text = ""
cboBarang.Text = ""
txtNamaBarang.Text = ""
txtHargaBarang.Text = ""
txtBanyaknyaBarang.Text = ""
txtJumlah.Text = ""
End With
End Sub
10. Program MDI
Private Sub cari_barang_Click()
CariBarang.Show
End Sub
Private Sub edit_barang_Click()
EditBarang.Show
End Sub
Private Sub edit_pelanggan_Click()
EditPelanggan.Show
End Sub
Private Sub edit_Pemasok_Click()
EditPemasok.Show
End Sub
Private Sub form_beli_Click()
FormBeli.Show
End Sub
Private Sub form_penjualan_Click()
FormJual.Show
End Sub
Private Sub input_barang_Click()
DataBarang.Show
End Sub
Private Sub input_pelanggan_Click()
DataPelanggan.Show
End Sub
Private Sub input_pemasok_Click()
DataSupplier.Show
End Sub
Private Sub lap_barang_Click()
MDIForm1.WindowState = 2
LapBarang.Show
End Sub
Private Sub lap_pelanggan_Click()
MDIForm1.WindowState = 2
LapPelanggan.Show
End Sub
11. DE(DE.Dsr)
- Connections
conAVB
- Commands
Pemasok
Pelanggan
Barang
12. Lap Barang
Private Sub DataReport_Terminate()
Unload Me
MDIForm1.WindowState = 0
End Sub
13. Lap Pelanggan
Private Sub DataReport_Terminate()
Unload Me
MDIForm1.WindowState = 0
End Sub
13. Lap Pemasok
Private Sub DataReport_Terminate()
Unload Me
MDIForm1.WindowState = 0
End Sub
Component yang digunakan :
Designers :
References :