MEMBUAT APLIKASI KASIR DASAR DENGAN VBA

Tahap awal pembuatan Aplikasi Kasir BerbasiS VBA.

teknisnya yang kita transaksikan masuk ke daftar dan langsung masuk ke Cell juga..




Private Sub CommandButton1_Click()

Dim lvwItem As ListItem
 
 With ListView1
 Set lvwItem = .ListItems.Add(, , Tkode.Value) '--- this is only added to listview
 lvwItem.SubItems(2) = Tbanyak.Value
 lvwItem.SubItems(1) = LBLNAMABARANG.Caption
 lvwItem.SubItems(3) = Thargapcs.Caption
 lvwItem.SubItems(4) = Tjmlhharga.Caption
 End With
LBLCOUNT.Caption = ListView1.ListItems.Count  'Menghitung Data Dalam ListView
 Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet1")
'menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
  .End(xlUp).Offset(1, 0).Row
ws.Cells(iRow, 1).Value = Tkode
ws.Cells(iRow, 2).Value = Me.LBLNAMABARANG.Caption
ws.Cells(iRow, 3).Value = Me.Tbanyak.Value
ws.Cells(iRow, 4).Value = Me.Thargapcs.Caption
ws.Cells(iRow, 5).Value = Me.Tjmlhharga.Caption

Tkode.Value = ""
Tbanyak.Value = ""
LBLNAMABARANG.Caption = ""
Thargapcs.Caption = ""
Tjmlhharga.Caption = ""
Tkode.SetFocus
Call totalharga

End Sub

Private Sub CommandButton2_Click()

End Sub

Private Sub Tbayar_Change()
a = Val(TextBox6.Text)
b = Val(Tbayar.Text)
c = b - a
Tkembali.Text = c

End Sub

Private Sub Tbayar_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
    Tbayar = Format(CDbl(Me.Tbayar.Value), "#,##0")
End Sub



Private Sub Tkode_Exit(ByVal Cancel As MSForms.ReturnBoolean)

CODE = Me.Tkode.Value
With Sheet2.Range("a2:C10000")
        Set a = .Find(CODE, LookIn:=xlValues)

        If Not a Is Nothing Then
            Baris = a.Row
            Me.LBLNAMABARANG.Caption = Sheet2.Cells(Baris, 2).Value 'mengambil data baris ke2 dari sheer "database
            Me.Thargapcs.Caption = Sheet2.Cells(Baris, 3).Value 'mengambil data baris ke2 dari sheer "database.Value = Worksheets("Masterdata").Cells(Baris, 2).Value 'mengambil data baris ke2 dari sheer "database
             Else
    MsgBox "Maaf, Kode Salah / Sepertinya Belum Update !"
    Tkode.Value = ""
    End If
    End With
End Sub

Private Sub Tbanyak_Change()
a = Val(Tbanyak.Text)
b = Val(Thargapcs.Caption)
c = a * b
Tjmlhharga.Caption = c

End Sub

Private Sub UserForm_Activate()
Tkode.SetFocus

End Sub

 Sub tampil()
Dim Item As ListItem
Dim rekamandata As Integer
Dim i As Integer
 ListView1.ListItems.Clear
 rekamandata = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
  For i = 4 To rekamandata
  Set Item = ListView1.ListItems.Add(Text:=Sheet1.Cells(i, 1))
  Item.SubItems(1) = Sheet1.Cells(i, 2)
  Item.SubItems(2) = Sheet1.Cells(i, 3)
  Item.SubItems(3) = Sheet1.Cells(i, 4)
  Item.SubItems(4) = Sheet1.Cells(i, 5)
 
  Next
  LBLCOUNT.Caption = ListView1.ListItems.Count  'Menghitung Data Dalam ListView
 
End Sub


 Private Sub UserForm_Initialize()
With ListView1
.Gridlines = True
.View = lvwReport
.FullRowSelect = True

.ColumnHeaders.Add Text:="Kode", Width:=80
.ColumnHeaders.Add Text:="Nama Produk", Width:=170
.ColumnHeaders.Add Text:="Banyak", Width:=50
.ColumnHeaders.Add Text:="Harga", Width:=50
.ColumnHeaders.Add Text:="Total Harga", Width:=70
End With
LBLCOUNT.Caption = ListView1.ListItems.Count  'Menghitung Data Dalam ListView

End Sub
 Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Tkode = ListView1.SelectedItem
Tbanyak = ListView1.SelectedItem.SubItems(1)
TextBox3 = ListView1.SelectedItem.SubItems(2)
Thargapcs = ListView1.SelectedItem.SubItems(3)
Tjmlhharga = ListView1.SelectedItem.SubItems(4)
End Sub


Private Sub totalharga()
Dim Index As Integer
Dim TotalValue As Double

For Index = 1 To ListView1.ListItems.Count
    TotalValue = TotalValue + ListView1.ListItems(Index).SubItems(4)
Next
Me.TextBox6.Text = TotalValue
Me.TextBox7.Caption = TotalValue
End Sub





2 Comments

  1. Apakah ada link downloadnya ?

    ReplyDelete
  2. Sory Gan, linknya belum di update, sebenarnya karena filenya juga msih proses di buat.. dan itupun jika waktunya senggang.. afwan yaaa

    ReplyDelete
Post a Comment
Previous Post Next Post