Latest News

Membuat Form Pemasok Pada VB 6.0

Setelah anda sukses membuat Tabel Pemasok pada postingan kami sebelumnya, kini saatnya anda membuat Form Pemasok dengan Design Form Seperti dibawah ini :


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"