Code Program Input Data Supplier (Sistem Penjualan dan Pembelian Alat Optik)

Pada posting kali ini admin akan melakukan sharing tentang kode program aplikasi penjualan dan pembelian alat optik.

Kode Program dibuat menggunakan Bahasa Pemrograman Visual Basic 6. Untuk lebih jelasnya berikut tampilan program form input data supplier.

Listing Code Program sebagai berikut :

Dim dataasal As Database
Dim tabelasal As Recordset
Dim isibaru As String
Dim tfi, tft As String
Private Sub Form_Load()
 Set dataasal = OpenDatabase(App.Path & "\jualbeli.mdb")
 Set tabelasal = dataasal.OpenRecordset("suplier", dbOpenDynaset)
 Set Data1.Recordset = tabelasal
 If tabelasal.RecordCount > 0 Then
  tft = "True"
  Call aturtombol(tft)
  Call isiantampil
 Else
  tft = "False"
  Call aturtombol(tft)
  baru.Enabled = True
  tutup.Enabled = True
  Call isiankosong
 End If
 tfi = "False"
 Call aturisian(tfi)
 isibaru = "T"
End Sub
Private Sub baru_Click()
 Dim nourut As Integer
 Dim kodebaru As String
 Dim info, dasar, batasan As String
 If baru.Caption = "&Baru" Then
  baru.Caption = "&Simpan"
  baru.ToolTipText = "Menyimpan Data"
  rubah.Caption = "&Batal"
  rubah.ToolTipText = "Membatalkan Data"
  isibaru = "Y"
  Call isiankosong
  DBGrid1.Enabled = False
  If tabelasal.RecordCount > 0 Then
   tabelasal.MoveLast
   nourut = Val(Right(tabelasal("kdsup"), 3)) + 1
   If nourut < 10 Then
    Text1 = "SP00" + LTrim(Str(nourut))
   ElseIf nourut < 100 Then
    Text1 = "SP0" + LTrim(Str(nourut))
   ElseIf nourut < 1000 Then
    Text1 = "SP" + LTrim(Str(nourut))
   Else
    Text1 = "SP000"
   End If
  Else
   Text1 = "SP001"
  End If
  tfi = "True"
  Call aturisian(tfi)
  tft = "False"
  Call aturtombol(tft)
  baru.Enabled = True
  rubah.Enabled = True
  Text2.SetFocus
 Else
  If Text2.Text = " " Then
    p = MsgBox("Nama supplier belum diisi...!", vbOKOnly + vbInformation, "Informasi")
  Else
   dasar = Text1.Text
   batasan = "kdsup='" & dasar & "'"
   tabelasal.FindFirst batasan
   If tabelasal.NoMatch Then
    tabelasal.AddNew
    Call simpanisian
    tabelasal.Update
   Else
    tabelasal.Edit
    Call simpanisian
    tabelasal.Update
   End If
   baru.Caption = "&Baru"
   baru.ToolTipText = "Mengisi Data Baru"
   rubah.Caption = "&Rubah"
   rubah.ToolTipText = "Merubah Data"
   tft = "True"
   Call aturtombol(tft)
   tfi = "False"
   Call aturisian(tfi)
   tabelasal.MoveLast
   Set Data1.Recordset = tabelasal
   DBGrid1.Enabled = True
   DBGrid1.ReBind
   isibaru = "T"
  End If
 End If
End Sub
Private Sub rubah_Click()
 If rubah.Caption = "&Rubah" Then
   baru.Caption = "&Simpan"
   baru.ToolTipText = "Menyimpan Data"
   rubah.Caption = "&Batal"
   rubah.ToolTipText = "Membatalkan Data"
   tfi = "True"
   Call aturisian(tfi)
   tft = "False"
   Call aturtombol(tft)
   baru.Enabled = True
   rubah.Enabled = True
   Text2.SetFocus
 Else
   baru.Caption = "&Baru"
   baru.ToolTipText = "Mengisi Data Baru"
   rubah.Caption = "&Rubah"
   rubah.ToolTipText = "Merubah Data"
   If tabelasal.RecordCount > 0 Then
    tft = "True"
    Call aturtombol(tft)
    Call isiantampil
   Else
    tft = "False"
    Call aturtombol(tft)
    baru.Enabled = True
    tutup.Enabled = True
    Call isiankosong
   End If
   tfi = "False"
   Call aturisian(tfi)
   DBGrid1.Enabled = True
   isibaru = "T"
 End If
End Sub
Private Sub hapus_Click()
 Dim hapus
 hapus = MsgBox("Yakin akan dihapus ?", 4 + 32, "Konfirmasi")
 If hapus = 6 Then
   If tabelasal.EOF = False Then
    tabelasal.Delete
    If tabelasal.RecordCount > 0 Then
     tabelasal.MoveNext
    Else
     tabelasal.MoveFirst
    End If
    Set Data1.Recordset = tabelasal
    DBGrid1.ReBind
   End If
 End If
End Sub
Private Sub tutup_Click()
    Unload Me
End Sub
Private Sub DBGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
 If isibaru = "T" Then
 Call isiantampil
 End If
End Sub
Private Sub text2_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  If Len(Trim(Text2.Text)) > 30 Then
   MsgBox ("Isian tidak valid, maksimal 30 karakter")
   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 ("Isian tidak valid, maksimal 50 karakter!")
   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 ("Isian tidak valid, maksimal 15 karakter!")
   Text4.SetFocus
  Else
   Text5.SetFocus
  End If
 End If
End Sub
Private Sub text5_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  If Len(Trim(Text5.Text)) > 13 Then
   MsgBox ("Isian tidak valid, maksimal 13 karakter!")
   Text5.SetFocus
  Else
   baru.SetFocus
  End If
 End If
End Sub
Private Sub isiankosong()
    Text1.Text = " "
    Text2.Text = " "
    Text3.Text = " "
    Text4.Text = " "
    Text5.Text = " "
End Sub
Public Sub simpanisian()
    With tabelasal
            !kdsup = Text1.Text
            !nmsup = Text2.Text
            !almsup = Text3.Text
            !kotasup = Text4.Text
            !telpsup = Text5.Text
    On Error GoTo 0
    End With
End Sub
Public Sub isiantampil()
If tabelasal.EOF = False Then
    Text1.Text = tabelasal("kdsup")
    Text2.Text = tabelasal("nmsup")
    Text3.Text = tabelasal("almsup")
    Text4.Text = tabelasal("kotasup")
    Text5.Text = tabelasal("telpsup")
Else
    Call isiankosong
End If
End Sub
Public Sub aturisian(tfi)
    Text2.Enabled = tfi
    Text3.Enabled = tfi
    Text4.Enabled = tfi
    Text5.Enabled = tfi
End Sub
Public Sub aturtombol(tft)
   baru.Enabled = tft
   rubah.Enabled = tft
   hapus.Enabled = tft
   tutup.Enabled = tft
End Sub

Tweet