Membuat Program Untuk Pemasok Barang

Minggu, 03 April 2011

Membuat Program Untuk Pemasok Barang

1. Kita klik kanan pada toolbox / pilih menu project Component
2. Beri tanda centang pada microsoft ADO data control 6.0 ( OLEDB ) / ADODC
3. Beri tanda centang pada microsoft tabbed dialog control 6.0

Kode Program :

Option explicit
Dim Medit As Boolean

Private Function Validasi() As Boolean
If Not RsPemasok.Recordset.RecordCount = 0 Then
RsPemasok.Recordset.Find "[KodePemasok]='" & TxtKode.Text & "'", adSearchForward, 1
If RsPemasok.Recordset.EOF Then
Validasi = True
Else
Validasi = False
End If
Else
Validasi = True
End If
End Function

Private Sub Aktif()
TxtKode.Enabled = True
TxtNama.Enabled = True
TxtAlamat.Enabled = True
TxtKota.Enabled = True
TxtTelp.Enabled = True
End Sub

Private Sub TidakAktif()
TxtKode.Enabled = False
TxtNama.Enabled = False
TxtAlamat.Enabled = False
TxtKota.Enabled = False
TxtTelp.Enabled = False
End Sub

Private Sub BersihTampilan()
TxtKode = ""
TxtNama = ""
TxtAlamat = ""
TxtKota = ""
TxtTelp = ""
End Sub

Private Sub CmdBatal_Click()
Call BersihTampilan
TidakAktif
CmdSimpan.Caption = "&Tambah"
Medit = False
End Sub

Private Sub CmdCetak_Click()
CrPemasok.ReportFileName = App.Path & "\Report\Pemasok.rpt"
CrPemasok.RetrieveDataFiles
CrPemasok.WindowState = crptMaximized
CrPemasok.Action = 1
End Sub

Private Sub CmdEdit_Click()
Edit = MsgBox("Apakah Data Mau Diedit?", vbQuestion + vbYesNo, "INFORMASI")
If Edit = vbYes Then
Medit = True
TabPemasok.Tab = 0
Aktif
CmdSimpan.Caption = "&Update"
TxtKode.Text = DataGrid1.Columns(0).Text
TxtKode.Enabled = False
RsPemasok.Recordset.Find "KodePemasok='" & TxtKode.Text & "'", , adSearchForward, 1
If Not RsPemasok.Recordset.EOF Then
On Error Resume Next
TxtKode = RsPemasok.Recordset!Kodepemasok
TxtNama = RsPemasok.Recordset!Namapemasok
TxtAlamat = RsPemasok.Recordset!Alamat
TxtKota = RsPemasok.Recordset!Kota
TxtTelp = RsPemasok.Recordset!Telp
TxtNama.SetFocus
End If
Else
Exit Sub
End If
End Sub

Private Sub CmdKeluar_Click()
Unload Me
End Sub

Private Sub CmdSimpan_Click()
If CmdSimpan.Caption = "&Tambah" Then 'Tombol Tambah
Aktif
BersihTampilan
TidakAktif
TxtKode.Enabled = True
TxtKode.SetFocus
CmdSimpan.Caption = "&Simpan"
Else 'Tombol SImpan / Update
If TxtKode = "" Or TxtNama = "" Or TxtAlamat = "" Or TxtKota = "" Or TxtTelp = "" Then
MsgBox "Data belum lengkap", vbOKOnly, "Informasi"
TxtKode.SetFocus
Else
If Not Medit Then
RsPemasok.Recordset.AddNew
RsPemasok.Recordset!Kodepemasok = TxtKode.Text
Else
RsPemasok.Recordset.Clone
End If
RsPemasok.Recordset!Namapemasok = TxtNama.Text
RsPemasok.Recordset!Alamat = TxtAlamat.Text
RsPemasok.Recordset!Kota = TxtKota.Text
RsPemasok.Recordset!Telp = TxtTelp.Text
RsPemasok.Recordset.Update
BersihTampilan
TidakAktif
MsgBox "Data berhasil disimpan", vbOKOnly, "Informasi"
CmdSimpan.Caption = "&Tambah"
End If
DataGrid1.Refresh
End If
End Sub

Private Sub CmdTutup_Click()
Unload Me
End Sub

Private Sub DataGrid1_DblClick()
CmdEdit_Click
End Sub

Private Sub Form_Load()
RsPemasok.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path &
"\Master.mdb;Jet OLEDB:Database Password=;"
RsPemasok.RecordSource = "TbPemasok"
Set DataGrid1.DataSource = RsPemasok
TidakAktif
Medit = False
End Sub

Private Sub OptKode_Click()
RsPemasok.Sort = "KodePemasok"
End Sub

Private Sub OPtNama_Click()
RsPemasok.Sort = "NamaPemasok"
End Sub

Private Sub TxtTelp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If Medit Then
CmdSimpan.SetFocus
Else
'TxtStokAwal.SetFocus
End If
End If
End Sub

Private Sub TxtKode_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
Aktif
TxtNama.SetFocus
If Not Validasi Then
CmdSimpan.Enabled = True
Jawab = MsgBox("Kode " & RsPemasok.Recordset!Kodepemasok & " sudah Ada",
vbExclamation, "Informasi")
If Jawab = vbOK Then
Aktif
BersihTampilan
TidakAktif
TxtKode.Enabled = True
TxtKode.SetFocus
End If
Else
CmdSimpan.Enabled = True
End If
End If
End Sub

Private Sub TxtAlamat_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtKota.SetFocus
End If
End Sub

Private Sub TxtNama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtAlamat.SetFocus
End If
End Sub

Private Sub TxtKota_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
TxtTelp.SetFocus
End If
End Sub

Ingin artikel Blog ini langsung ke Email anda? Silahkan masukan alamat email anda untuk berlangganan.

Masukan Alamat Email Anda :