Code Program Input Data Pemasok Sisfo Administrasi Toko

Pada postingan kali ini admin akan melakukan posting tentang pembuatan Sisfo Administrasi Toko, form pertama yang akan dibuat yaitu Form Input Data pemasok. Aplikasi dibuat menggunakan Visual Basic 6 dengan Database Ms.Access.

Untuk Tampilannya sebagai berikut :

Listing Code Program sebagai berikut :

Dim dtbs As Database
Dim tbl As Recordset
Dim konterdata
Private Sub cmdbaru_Click()
If cmdbaru.Caption = "&Baru" Then
 cmdbaru.Caption = "&Simpan"
 cmdrubah.Caption = "&Batal"
 Call frmkosong
 Call frmaktif
 Call cmdtdaktif
 cmdbaru.Enabled = True
 cmdrubah.Enabled = True
 konterdata = "Y"
 DBGrid1.Enabled = False
 Call buatkode
 Text2.SetFocus
Else
 Dim caridata As String, kunci As String
 If Text2.Text = " " Then
   p = MsgBox("Nama pemasok belum diisi...!", vbOKOnly + vbInformation, "Informasi")
   Text2.SetFocus
 Else
 kunci = Text1.Text
 caridata = "kdpemasok='" & kunci & "'"
 tbl.FindFirst caridata
 If tbl.NoMatch Then
  tbl.AddNew
  Call frmmasuk
  tbl.Update
 Else
  tbl.Edit
  Call frmmasuk
  tbl.Update
 End If
 cmdbaru.Caption = "&Baru"
 cmdrubah.Caption = "&Rubah"
 Call cmdaktif
 Call frmtdaktif
 konterdata = "T"
 DBGrid1.Enabled = True
 tbl.MoveLast
 Set Data1.Recordset = tbl
 DBGrid1.ReBind
 End If
End If
End Sub
Private Sub Form_Activate()
Label1.Caption = gnamains
Label2.Caption = galins
Label3.Caption = gtelpins
End Sub
Private Sub Form_Load()
    Call tetapkandata
    konterdata = "T"
    DBGrid1.ReBind
    Call cekdata
End Sub
Private Sub cmdrubah_Click()
If cmdrubah.Caption = "&Rubah" Then
 cmdrubah.Caption = "&Batal"
 cmdbaru.Caption = "&Simpan"
 konterdata = "T"
 DBGrid1.Enabled = False
 Call frmaktif
 Call cmdtdaktif
 cmdbaru.Enabled = True
 cmdrubah.Enabled = True
 Text2.SetFocus
Else
 cmdrubah.Caption = "&Rubah"
 cmdbaru.Caption = "&Baru"
 konterdata = "T"
 DBGrid1.Enabled = True
 Call cekdata
End If
End Sub
Private Sub cmdhapus_Click()
    On Error Resume Next
    hapus = MsgBox("Yakin akan dihapus ?", vbOKCancel + vbQuestion, "Konfirmasi")
    If hapus = vbOK Then
        tbl.Delete
        tbl.MoveNext
    Else
        tbl.MoveFirst
    End If
        Call tetapkandata
        DBGrid1.ReBind
        On Error GoTo 0
End Sub
Private Sub cmdtutup_Click()
    Unload Me
End Sub
Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
 If konterdata = "T" Then
  Call frmtampil
 End If
End Sub
Public Sub buatkode()
 If tbl.RecordCount > 0 Then
  tbl.MoveLast
  nourut = Val(Right(tbl("kdpemasok"), 4)) + 1
  If nourut < 10 Then
   Text1.Text = "PMS000" + LTrim(Str(nourut))
  ElseIf nourut < 100 Then
   Text1.Text = "PMS00" + LTrim(Str(nourut))
  ElseIf nourut < 1000 Then
   Text1.Text = "PMS0" + LTrim(Str(nourut))
  ElseIf nourut < 10000 Then
   Text1.Text = "PMS" + LTrim(Str(nourut))
  Else
   Text1.Text = "PMS0000"
  End If
 Else
  Text1.Text = "PMS0001"
 End If
End Sub
Private Sub Form_Resize()
bg.Width = Me.Width
bg.Height = Me.Height
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  If Len(Trim(Text2.Text)) > 50 Then
   MsgBox ("Maksimal 50 karakter, coba cek lagi!")
   Text2.SetFocus
  Else
   Text3.SetFocus
  End If
 End If
End Sub
Private Sub text3_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  If Len(Trim(Text3.Text)) > 50 Then
   MsgBox ("Maksimal 50 karakter, coba cek lagi!")
   Text3.SetFocus
  Else
   Text4.SetFocus
  End If
 End If
End Sub
Private Sub text4_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  If Len(Trim(Text4.Text)) > 15 Then
   MsgBox ("Maksimal 15 karakter, coba cek lagi!")
   Text4.SetFocus
  Else
   cmdbaru.SetFocus
  End If
 End If
End Sub
Private Sub frmkosong()
    Text1.Text = " "
    Text2.Text = " "
    Text3.Text = " "
    Text4.Text = " "
End Sub
Public Sub frmaktif()
    Text2.Enabled = True
    Text3.Enabled = True
    Text4.Enabled = True
End Sub
Public Sub frmtdaktif()
    Text2.Enabled = False
    Text3.Enabled = False
    Text4.Enabled = False
End Sub
Public Sub frmmasuk()
    With tbl
            !kdpemasok = Trim(Text1.Text)
            !nmpemasok = Trim(Text2.Text)
            !alpemasok = Trim(Text3.Text)
            !telppemasok = Trim(Text4.Text)
    On Error GoTo 0
    End With
End Sub
Public Sub frmtampil()
If tbl.EOF = False Then
    Text1.Text = tbl("kdpemasok")
    Text2.Text = tbl("nmpemasok")
    Text3.Text = tbl("alpemasok")
    Text4.Text = tbl("telppemasok")
Else
    Call frmkosong
End If
End Sub
Public Sub cmdaktif()
   cmdbaru.Enabled = True
   cmdrubah.Enabled = True
   cmdhapus.Enabled = True
   cmdtutup.Enabled = True
End Sub
Public Sub cmdtdaktif()
   cmdbaru.Enabled = False
   cmdrubah.Enabled = False
   cmdhapus.Enabled = False
   cmdtutup.Enabled = False
End Sub
Public Sub cekdata()
 If tbl.RecordCount > 0 Then
  Call cmdaktif
  Call frmtampil
 Else
  Call cmdtdaktif
  cmdbaru.Enabled = True
  cmdtutup.Enabled = True
  Call frmkosong
 End If
 Call frmtdaktif
End Sub
Public Sub tetapkandata()
    Set dtbs = OpenDatabase(App.Path & "\datatoko.mdb")
    Set tbl = dtbs.OpenRecordset("pemasok", dbOpenDynaset)
    Set Data1.Recordset = tbl
End Sub

Tweet