Berikut Listing Kodingnya :
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 = "" Or Text5 = "" Then
MsgBox "Masih Ada Data Yang Kosong", vbInformation, "Pemberitahuan"
Else
Dim SQLEdit As String
SQLEdit = "Update Pemasok Set NamaPemasok= '" & Text2 & "', ALamatPemasok='" & Text3 & "', TelpPemasok='" & Text4 & "',Person='" & Text5 & "' where KodePemasok='" & Text1 & "'"
koneksi.Execute SQLEdit
MsgBox "Data Berhasil Diedit", vbInformation, "Pemberitahuan"
Form_Activate
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 = "Pemasok"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
Call kondisiawal
CmdInput.SetFocus
End Sub
Private Sub AutoNomor()
Call BukaDB
RSPemasok.Open ("select * from Pemasok Where KodePemasok In(Select Max(KodePemasok)From Pemasok)Order By kodePemasok Desc"), koneksi
RSPemasok.Requery
Dim Urutan As String * 6
Dim Hitung As Long
With RSPemasok
If .EOF Then
Urutan = "PMK" + "001"
Text1 = Urutan
Else
Hitung = Right(!KodePemasok, 3) + 1
Urutan = "PMK" + Right("000" & Hitung, 3)
End If
Text1 = Urutan
End With
End Sub
Sub Form_Load()
Text1.MaxLength = 6
Text2.MaxLength = 50
Text3.MaxLength = 50
Text4.MaxLength = 20
Text5.MaxLength = 30
kondisiawal
End Sub
Private Sub kosongkantext()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
End Sub
Private Sub SiapIsi()
Text1.Enabled = True
Text2.Enabled = True
Text3.Enabled = True
Text4.Enabled = True
Text5.Enabled = True
End Sub
Private Sub TidakSiapIsi()
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
Text5.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 RSPemasok
If Not RSPemasok.EOF Then
Text2 = RSPemasok!NamaPemasok
Text3 = RSPemasok!AlamatPemasok
Text4 = RSPemasok!TelpPemasok
Text5 = RSPemasok!TelpPemasok
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 = "" Or Text5 = "" Then
MsgBox "Data Belum Lengkap...!", vbInformation, "Pemberitahuan"
Else
Dim SQLTambah As String
SQLTambah = "Insert Into Pemasok (KodePemasok,NamaPemasok,AlamatPemasok,TelpPemasok,Person) values ('" & Text1 & "','" & Text2 & "','" & Text3 & "','" & Text4 & "','" & Text5 & "')"
koneksi.Execute SQLTambah
MsgBox "Data Berhasil Ditambah", vbInformation, "Pemberitahuan"
Form_Activate
Call kondisiawal
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
RSPemasok.Open "Select * From Pemasok where KodePemasok='" & 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 RSPemasok.EOF Then
TampilkanData
MsgBox "Kode Pemasok Sudah Ada", vbInformation, "Pemberitahuan"
kosongkantext
Text1.SetFocus
Else
Text2.SetFocus
End If
End If
If CmdEdit.Caption = "&Simpan" Then
Call CariData
If Not RSPemasok.EOF Then
TampilkanData
Text1.Enabled = False
Text2.SetFocus
Else
MsgBox "Kode Pemasok Tidak Ada", vbInformation, "Pemberitahuan"
Text1 = ""
Text1.SetFocus
End If
End If
If CmdHapus.Enabled = True Then
Call CariData
If Not RSPemasok.EOF Then
TampilkanData
Pesan = MsgBox("Yakin akan dihapus", vbYesNo)
If Pesan = vbYes Then
Dim SQLHapus As String
SQLHapus = "Delete From Pemasok where kodePemasok= '" & 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
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then Text5.SetFocus
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
If KeyAscii = 13 Then
If CmdInput.Enabled = True Then
CmdInput.SetFocus
ElseIf CmdEdit.Enabled = True Then
CmdEdit.SetFocus
End If
End If
End Sub
Catatan :
Seperti biasa, pada Form Menu utama tambahkan Menu Editor yaitu Master Pemasok
0 Response to "Membuat Form Pemasok Pada VB 6.0"