Code Program Input Data Barang 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 barang. 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, tblrinci, tbl2, tbl3, tbl4 As Recordset
Dim konterdata, rubahdata
Private Sub cmdselesai_Click()
Frame5.Visible = False
Call buatkode
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text9.Text = " "
Text10.Text = " "
Label11.Caption = 0
Call saringdata
End Sub
Private Sub cmdbaru_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text9.Text = " "
Text10.Text = " "
Text11.Text = " "
Text12.Text = " "
Text1.SetFocus
End Sub
Private Sub cmdcari_Click()
Frame5.Visible = True
DBGrid3.SetFocus
End Sub
Private Sub cmdisi_Click()
 Call buatkode
 Text3.Text = " "
 Text11.Text = " "
 Text12.Text = " "
 Text3.SetFocus
End Sub
Private Sub cmdrubah_Click()
rubahdata = "Y"
cmdrubah.Enabled = False
cmdkurang.Enabled = False
Text7.SetFocus
End Sub
Private Sub cmdtutupframe5_Click()
 Frame5.Visible = False
End Sub
Private Sub DBGrid1_DblClick()
cmdkurang.Enabled = True
cmdrubah.Enabled = True
rubahdata = "Y"
Text4.Text = Data1.Recordset("kodebrg")
Text5.Text = Data1.Recordset("namabrg")
Text6.Text = Data1.Recordset("hargabeli")
Text7.Text = Data1.Recordset("jmlbeli")
Text13.Text = Data1.Recordset("jmlbeli")
End Sub
Private Sub DBGrid2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Frame4.Visible = False
Text7.SetFocus
End If
End Sub
Private Sub DBGrid2_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Text4.Text = Data2.Recordset("kodebrg")
Text5.Text = Data2.Recordset("namabrg")
Text6.Text = Data2.Recordset("hrgbeli")
End Sub
Private Sub DBGrid3_DblClick()
Text2.Text = Data3.Recordset("kdpemasok")
Text3.Text = Data3.Recordset("nmpemasok")
Text11.Text = Data3.Recordset("alpemasok")
Text12.Text = Data3.Recordset("telppemasok")
Frame5.Visible = False
Text4.SetFocus
End Sub
Private Sub DBGrid3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Frame5.Visible = False
Text4.SetFocus
End If
End Sub
Private Sub DBGrid3_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
   If Len(Text2.Text) > 0 Then
      Frame5.Visible = False
   End If
  End If
End Sub
Private Sub DBGrid3_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Text2.Text = Data3.Recordset("kdpemasok")
Text3.Text = Data3.Recordset("nmpemasok")
Text11.Text = Data3.Recordset("alpemasok")
Text12.Text = Data3.Recordset("telppemasok")
End Sub
Private Sub Form_Activate()
Label1.Caption = gnamains
Label2.Caption = galins
Label3.Caption = gtelpins
End Sub
Private Sub Form_Load()
    Set dtbs = OpenDatabase(App.Path & "\datatoko.mdb")
    Set tbl = dtbs.OpenRecordset("beli", dbOpenDynaset)
    Set tblrinci = dtbs.OpenRecordset("rbeli", dbOpenDynaset)
    Set tbl2 = dtbs.OpenRecordset("qbeli", dbOpenDynaset)
    Set tbl3 = dtbs.OpenRecordset("barang", dbOpenDynaset)
    Set tbl4 = dtbs.OpenRecordset("pemasok", dbOpenDynaset)
 
    Set Data1.Recordset = tbl2
    Set Data2.Recordset = tbl3
    Set Data3.Recordset = tbl4
    Frame4.Visible = False
    Frame5.Visible = False
 
    cmdkurang.Enabled = False
    cmdrubah.Enabled = False
    cmdbaru.Enabled = False
 
    Text1.Text = " "
    Text2.Text = " "
    Text3.Text = " "
    Text4.Text = " "
    Text5.Text = " "
    Text6.Text = " "
    Text7.Text = " "
    Text8.Text = " "
    Text9.Text = " "
    Text10.Text = " "
    Text11.Text = " "
    Text12.Text = " "
    rubahdata = "T"
    Call saringdata
End Sub
Private Sub cmdlihat_Click()
Frame4.Visible = True
rubahdata = "T"
'DBGrid2.ReBind
DBGrid2.SetFocus
End Sub
Private Sub cmdtutup_Click()
Unload Me
End Sub
Private Sub Form_Resize()
bg.Width = Me.Width
bg.Height = Me.Height
End Sub
Private Sub cmdok_Click()
 Dim caridata As String, kunci As String
 If Text1.Text = " " Or Text2.Text = " " Or Text4.Text = " " Or Val(Text7.Text) <= 0 Then
   p = MsgBox("Nomor nota, kode pemasok atau kode barang atau jumlah belum diisi...!", vbOKOnly + vbInformation, "Informasi")
   If Text1.Text = " " Then
    Text1.SetFocus
   ElseIf Text2.Text = " " Then
    Text2.SetFocus
   ElseIf Text4.Text = " " Then
    Text4.SetFocus
   End If
 Else
 kunci = Text1.Text
 caridata = "notabeli='" & kunci & "'"
 tbl.FindFirst caridata
 If tbl.NoMatch Then
  tbl.AddNew
  Call masuknota
  tbl.Update
 End If
 If rubahdata = "T" Then
 Call cekpemasok
 Call frmmasuk
 Call tambahstok
 Call saringdata
 ElseIf rubahdata = "Y" Then
 Call rubah
 Call saringdata
 End If
 cmdbaru.Enabled = True
 Text4.Text = " "
 Text5.Text = " "
 Text6.Text = " "
 Text7.Text = " "
 rubahdata = "T"
 cmdrubah.Enabled = False
 cmdkurang.Enabled = False
 Text4.SetFocus
End If
End Sub
Private Sub DBGrid2_DblClick()
Text4.Text = Data2.Recordset("kodebrg")
Text5.Text = Data2.Recordset("namabrg")
Text6.Text = Data2.Recordset("hrgbeli")
Frame4.Visible = False
Text7.SetFocus
End Sub
Private Sub DBGrid2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Text4.Text = Data2.Recordset("kodebrg")
Text5.Text = Data2.Recordset("namabrg")
Text6.Text = Data2.Recordset("hrgbeli")
Frame4.Visible = False
End If
End Sub
Private Sub Text1_Change()
 Dim caridata As String, kunci As String
 kunci = Text1.Text
 caridata = "notabeli='" & kunci & "'"
 Call saringdata
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
 If Len(Text1.Text) > 10 Then
    p = MsgBox("Nomor nota, maks hanya 10 karakter...!", vbOKOnly + vbInformation, "Informasi")
    Text1.SetFocus
 Else
    DTPicker1.SetFocus
 End If
End If
End Sub
Private Sub Text4_Change()
 If Frame4.Visible = False Then
 Dim caridata As String, kunci As String
 kunci = Text4.Text
 caridata = "kodebrg='" & kunci & "'"
 tbl3.FindFirst caridata
 If tbl3.NoMatch Then
  Text5.Text = " "
  Text6.Text = 0
 Else
  Text5.Text = tbl3("namabrg")
  Text6.Text = tbl3("hrgbeli")
  Text7.SetFocus
 End If
End If
End Sub
Private Sub Text6_Change()
Text8.Text = Val(Text6.Text) * Val(Text7.Text)
End Sub
Private Sub Text7_Change()
Text8.Text = Val(Text6.Text) * Val(Text7.Text)
End Sub
Public Sub masuknota()
    With tbl
            !notabeli = Trim(Text1.Text)
            !tglbeli = DTPicker1.Value
            !kdpemasok = Text2.Text
    On Error GoTo 0
    End With
End Sub
Public Sub frmmasuk()
    With tblrinci
            .AddNew
            !notabeli = Text1.Text
            !kodebrg = Text4.Text
            !hargabeli = Text6.Text
            !jmlbeli = Text7.Text
            .Update
    On Error GoTo 0
    End With
End Sub
Public Sub saringdata()
 Dim vnota As String
 Dim vsubtotal, vjmlbarang As Double
 saring = "parameters vnota string;select * from qbeli where trim(notabeli)=trim(vnota)"
 Set tds = dtbs.CreateQueryDef("", saring)
 tds.Parameters![vnota] = Text1.Text
 Set tbs = tds.OpenRecordset()
 Set Data1.Recordset = tbs
 DBGrid1.ReBind
 If tbs.RecordCount > 0 Then
 tbs.MoveFirst
 Do While tbs.EOF = False
 vsubtotal = vsubtotal + (tbs("hargabeli") * tbs("jmlbeli"))
 vjmlbarang = vjmlbarang + tbs("jmlbeli")
 tbs.MoveNext
 Loop
 Text9.Text = vsubtotal
 Text10.Text = vjmlbarang
 Label11.Caption = Format(Text9.Text, "###,##0")
 End If
 End Sub
Private Sub ttframe4_Click()
Frame4.Visible = False
Text7.SetFocus
End Sub
Public Sub kurangstok()
 Dim caridata As String, kunci As String
 kunci = Text4.Text
 caridata = "kodebrg='" & kunci & "'"
 tbl3.FindFirst caridata
 If tbl3.NoMatch Then
 Else
  tbl3.Edit
  tbl3("jmlstok") = tbl3("jmlstok") - Val(Text7.Text)
  tbl3.Update
 End If
End Sub
Public Sub tambahstok()
 Dim caridata As String, kunci As String
 kunci = Text4.Text
 caridata = "kodebrg='" & kunci & "'"
 tbl3.FindFirst caridata
 If tbl3.NoMatch Then
 Else
  tbl3.Edit
  tbl3("jmlstok") = tbl3("jmlstok") + Val(Text7.Text)
  tbl3.Update
 End If
End Sub
Private Sub cmdkurang_Click()
 Dim caridata As String, kunci1 As String, kunci2 As String
 kunci1 = Text1.Text
 kunci2 = Text4.Text
 caridata = "notabeli='" & kunci1 & "' and kodebrg='" & kunci2 & "'"
 tblrinci.FindFirst caridata
 If tblrinci.NoMatch Then
 Else
  tblrinci.Delete
  Call kurangstok
  Call saringdata
  Text4.Text = " "
  Text5.Text = " "
  Text6.Text = " "
  Text7.Text = " "
 End If
 cmdkurang.Enabled = False
 cmdrubah.Enabled = False
End Sub
Public Sub buatkode()
 If tbl4.RecordCount > 0 Then
  tbl4.MoveLast
  nourut = Val(Right(tbl4("kdpemasok"), 4)) + 1
  If nourut < 10 Then
   Text2.Text = "PMS000" + LTrim(Str(nourut))
  ElseIf nourut < 100 Then
   Text2.Text = "PMS00" + LTrim(Str(nourut))
  ElseIf nourut < 1000 Then
   Text2.Text = "PMS0" + LTrim(Str(nourut))
  ElseIf nourut < 10000 Then
   Text2.Text = "PMS" + LTrim(Str(nourut))
  Else
   Text2.Text = "PMS0000"
  End If
 Else
  Text2.Text = "PMS0001"
 End If
End Sub

Public Sub cekpemasok()
 Dim caridata As String, kunci As String
 kunci = Text2.Text
 caridata = "kdpemasok='" & kunci & "'"
 tbl4.FindFirst caridata
 If tbl4.NoMatch Then
  tbl4.AddNew
      With tbl4
            !kdpemasok = Text2.Text
            !nmpemasok = Text3.Text
            !alpemasok = Text11.Text
            !telppemasok = Text12.Text
    On Error GoTo 0
    End With
  tbl4.Update
 End If
End Sub
Public Sub rubah()
 Dim caridata As String, kunci As String, kunci1 As String, kunci2 As String
 If Val(Text7.Text) > Val(Text13.Text) Then
  selisih = Val(Text7.Text) - Val(Text13.Text)
  kunci = Text4.Text
  caridata = "kodebrg='" & kunci & "'"
  tbl3.FindFirst caridata
  If tbl3.NoMatch Then
  Else
   tbl3.Edit
   tbl3("jmlstok") = tbl3("jmlstok") + selisih
   tbl3.Update
  End If
 ElseIf Val(Text7.Text) < Val(Text13.Text) Then
  selisih = Val(Text13.Text) - Val(Text7.Text)
  kunci = Text4.Text
  caridata = "kodebrg='" & kunci & "'"
  tbl3.FindFirst caridata
  If tbl3.NoMatch Then
  Else
   tbl3.Edit
   tbl3("jmlstok") = tbl3("jmlstok") - selisih
   tbl3.Update
  End If
 End If
 kunci1 = Text1.Text
 kunci2 = Text4.Text
 caridata = "notabeli='" & kunci1 & "' and kodebrg ='" & kunci2 & "'"
 tblrinci.FindFirst caridata
 If tblrinci.NoMatch Then

 Else
  tblrinci.Edit
  tblrinci("hargabeli") = Text6.Text
  tblrinci("jmlbeli") = Text7.Text
  tblrinci.Update
 End If
End Sub

Tweet