Dan berikut Listing Koding nya :
Dim mvBookMark As Variant
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 = "" Then
MsgBox "Masih Ada Data Yang Kosong", vbInformation, "Pemberitahuan"
Else
If Val(Text4) <= Val(Text3) Then
MsgBox "Harga Jual Tidak Boleh Lebih Kecil Atau Sama Dengan Harga Beli !"
Text4 = ""
Text4.SetFocus
Else
Dim SQLEdit As String
SQLEdit = "Update Barang Set NamaBarang= '" & Text2 & "', HargaBeli='" & Text3 & "', HargaJual='" & Text4 & "' where KodeBarang='" & Text1 & "'"
koneksi.Execute SQLEdit
MsgBox "Data Berhasil Diedit", vbInformation, "Pemberitahuan"
Form_Activate
End If
End If
End If
End Sub
Private Sub Form_Activate()
Call BukaDB
Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\DBTunasMedia.mdb"
Adodc1.RecordSource = "Barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
Call kondisiawal
CmdInput.SetFocus
End Sub
Private Sub AutoNomor()
Call BukaDB
RSBarang.Open ("select * from Barang Where KodeBarang In(Select Max(KodeBarang)From Barang)Order By kodeBarang Desc"), koneksi
RSBarang.Requery
Dim Urutan As String * 6
Dim Hitung As Long
With RSBarang
If .EOF Then
Urutan = "BRG" + "001"
Text1 = Urutan
Else
Hitung = Right(!KodeBarang, 3) + 1
Urutan = "BRG" + Right("000" & Hitung, 3)
End If
Text1 = Urutan
End With
End Sub
Sub Form_Load()
Text1.MaxLength = 6
Text2.MaxLength = 50
Text3.MaxLength = 12
Text4.MaxLength = 12
kondisiawal
End Sub
Private Sub kosongkantext()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
End Sub
Private Sub SiapIsi()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
End Sub
Private Sub TidakSiapIsi()
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.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!NamaBarang
Text3 = RSBarang!HargaBeli
Text4 = RSBarang!HargaJual
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
Call AutoNomor
Text1.Enabled = False
Text2.SetFocus
Else
If Text1 = "" Or Text2 = "" Or Text3 = "" Or Text4 = "" Then
MsgBox "Data Belum Lengkap...!", vbInformation, "Pemberitahuan"
Else
If Val(Text4) <= Val(Text3) Then
MsgBox "Harga Jual Tidak Boleh Lebih Kecil Atau Sama Dengan Harga Beli !"
Text4 = ""
Text4.SetFocus
Else
Dim SQLTambah As String
SQLTambah = "Insert Into Barang (KodeBarang,NamaBarang,HargaBeli,HargaJual) values ('" & Text1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "')"
koneksi.Execute SQLTambah
MsgBox "Data Berhasil Ditambah", vbInformation, "Pemberitahuan"
Form_Activate
Call kondisiawal
End If
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
Function CariData()
Call BukaDB
RSBarang.Open "Select * From Barang where KodeBarang='" & Text1 & "'", koneksi
End Function
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If Len(Text1) < 6 Then
MsgBox "Kode Harus 6 Digit", vbInformation, "Pemberitahuan"
Text1.SetFocus
Exit Sub
Else
Text2.SetFocus
End If
If CmdInput.Caption = "&Simpan" Then
Call CariData
If Not RSBarang.EOF Then
TampilkanData
MsgBox "Kode Barang Sudah Ada", vbInformation, "Pemberitahuan"
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", vbInformation, "Pemberitahuan"
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 kodeBarang= '" & Text1 & "'"
koneksi.Execute SQLHapus
MsgBox "Data Berhasil Dihapus", vbInformation, "Pemberitahuan"
kondisiawal
Form_Activate
Else
kondisiawal
CmdHapus.SetFocus
End If
Else
MsgBox "Data Tidak Ditemukan", vbInformation, "Pemberitahuan"
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 Text4.SetFocus
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = vbKeyReturn) 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 Tidak Boleh Lebih Kecil Atau Sama Dengan Harga Beli !"
Text4 = ""
Else
If CmdInput.Enabled = True Then
CmdInput.SetFocus
ElseIf CmdEdit.Enabled = True Then
CmdEdit.SetFocus
End If
End If
End If
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack Or KeyAscii = vbKeyReturn) Then KeyAscii = 0
End Sub
Catatan :
Jangan Lupa di Menu Editor pada FormMenuUtama di tambahkan MasterBarang
No comments:
Post a Comment