Listing Apotik

Tadi kita sudah membuat form-form'a sekarang kita akan membuat listing'a

Private Sub bersih()
txtid.Text = ""
txtnm.Text = ""
txttlp.Text = ""
txtalmt.Text = ""
End Sub

Private Sub nonaktif()
txtid.Enabled = False
txtnm.Enabled = False
txttlp.Enabled = False
txtalmt.Enabled = False
End Sub

Private Sub aktif()
txtid.Enabled = True
txtnm.Enabled = True
txttlp.Enabled = True
txtalmt.Enabled = True
End Sub

Private Sub tampil()
On Error Resume Next
txtid.Text = Data1.Recordset!id_apoteker
txtnm.Text = Data1.Recordset!nm_apoteker
txtalmt.Text = Data1.Recordset!alamat
txttlp.Text = Data1.Recordset!phone
End Sub

Private Sub nomor()
Dim ltanggal As String
Dim urutan As String * 9
Dim hitung As Byte
ltanggal = Format(Date, "ddmmyy")

With Data2
.DatabaseName = "C:\folder endah\simulasi ukk\rs.mdb"
.RecordsetType = 2
.RecordSource = "select id_nota from pembayaran where left(id_nota,6)='" & ltanggal & "'"
.Refresh
If .Recordset.RecordCount = 0 Then
urutan = ltanggal & "001"
Else
.Recordset.MoveLast
hitung = Val(Right(.Recordset!id_nota, 3)) + 1
urutan = ltanggal & Right("000" & hitung, 3)
End If
txtidnota.Text = urutan
End With
End Sub

Private Sub total_harga()
On Error Resume Next
DBGrid1.Col = 4
total = 0
sementara.Recordset.MoveFirst
Do While Not sementara.Recordset.EOF
sementara.Recordset!jmlhbyr = DBGrid1.SelText
total = total + DBGrid1.SelText
sementara.Recordset.MoveNext
Loop
txttot.Text = total
On Error GoTo 0
End Sub

Private Sub form_activate()
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
End Sub

Private Sub DBCombo1_Click(Area As Integer)
If Len(Trim(DBCombo1.Text)) > 5 Then
Exit Sub
End If
'CARI KODE APOTEKER
cost.Recordset.Index = "id_cos"
cost.Recordset.Seek "=", DBCombo1.Text
If cost.Recordset.NoMatch Then
MsgBox "ID Costomer Tidak Ada", vbOKOnly, "..::Konfirmasi::.."
Text4.Text = ""
DBCombo1.SetFocus
Exit Sub
End If
Text4.Text = cost.Recordset!nama_cos
DBCombo2.SetFocus
End Sub


Private Sub cmdadd_Click()
Call nomor
Call aktif
txtid.Enabled = False
txtnm.SetFocus
cmdadd.Enabled = False
cmdedit.Enabled = False
cmdsave.Enabled = True
cmdcancel.Enabled = True
End Sub


Private Sub cmdcancel_Click()
Call bersih
Call nonaktif
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdadd.Enabled = True
cmdedit.Enabled = True
End Sub


Private Sub cmddelete_Click()
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(txtid.Text)
If Not Data1.Recordset.NoMatch Then
Data1.Recordset.Delete
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdadd.Enabled = True
cmdedit.Enabled = True
End If
End Sub

Private Sub cmdedit_Click()
Dim x As String
x = InputBox("Masukkan ID Apoteker Yang Akan Anda Edit", "EDIT")
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(x)
If Not Data1.Recordset.NoMatch Then
Call tampil
Call aktif
txtid.Enabled = False
cmdsave.Enabled = True
cmddelete.Enabled = True
cmdcancel.Enabled = True
cmdadd.Enabled = False
cmdedit.Enabled = False
txtnm.SetFocus
Else
MsgBox "ID Apoteker Tidak Ada", vbOKOnly, "EDIT"
Call bersih
Call nonaktif
End If
End Sub


Private Sub cmdcari_Click()
Dim x As String
x = InputBox("Masukkan ID Apoteker Yang Anda Cari", "SEARCH")
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", UCase(x)
If Not Data1.Recordset.NoMatch Then
Call tampil
Call nonaktif
Else
MsgBox "ID Apoteker Tidak Ada", vbOKOnly, "SEARCH"
Call bersih
Call nonaktif
End If
cmdcancel.Enabled = True
End Sub


Private Sub cmdsave_Click()
If txtnm.Text = "" Or txttlp.Text = "" Or txtalmt.Text = "" Then
MsgBox "Data Masih Ada Yang Kosong", vbOKOnly, "Data Belum Lengkap"
Else
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", txtid.Text
If Not Data1.Recordset.NoMatch Then
Data1.Recordset.Edit
Data1.Recordset!id_apoteker = txtid.Text
Data1.Recordset!nm_apoteker = txtnm.Text
Data1.Recordset!alamat = txtalmt.Text
Data1.Recordset!phone = txttlp.Text
Data1.Recordset.Update
Else
Data1.Recordset.AddNew
Data1.Recordset!id_apoteker = txtid.Text
Data1.Recordset!nm_apoteker = txtnm.Text
Data1.Recordset!alamat = txtalmt.Text
Data1.Recordset!phone = txttlp.Text
Data1.Recordset.Update
End If
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = True
cmdadd.Enabled = True
End If
End Sub


Private Sub Cmdshow_Click()
Frame1.Visible = True
Frame2.Visible = True
cmdadd.Visible = True
cmdedit.Visible = True
cmdsave.Visible = True
cmddelete.Visible = True
cmdcari.Visible = True
cmdexit.Visible = True
cmdcancel.Visible = True
Command1.Visible = False
End Sub

ni listing yang combo'a da 2

Private Sub Combo1_Click()
Text1.Text = Mid(Combo1.Text, 7, 100)
Text2.Text = Left(Combo1.Text, 5)
End Sub

bis di tulis listing nie masukin juga listing di form load

Private Sub form_activate()
Data2.Recordset.MoveFirst
Do While Not Data2.Recordset.EOF
Combo1.AddItem Data2.Recordset!id_jenis & " " & Data2.Recordset!jns_obat
Data2.Recordset.MoveNext
Loop
Call nonaktif
Call bersih
cmdsave.Enabled = False
cmddelete.Enabled = False
cmdcancel.Enabled = False
End Sub

nie listing u untuk harga + laba otomatis

Private Sub txtharga_Change()
If txtharga.Text = "" Or Val(txtharga.Text) <>
Exit Sub
Else
Dim x As String
x = Val(txtharga.Text) / Val(txtisi.Text) * 20 / 100
txthrgsat.Text = x
End If
End Sub


nie listing wat form login

Private Sub Form_Load()
teks = Me.Caption
End Sub

Private Sub form_activate()
txtUserName.MaxLength = 5
End Sub

Private Sub cmdcancel_Click()
End
End Sub

Private Sub cmdOK_Click()
Data1.Recordset.Index = "id_apoteker"
Data1.Recordset.Seek "=", txtPassword.Text
If Data1.Recordset.NoMatch Then
MsgBox "Invalid ID Apoteker?", vbOKOnly, "Informasi"
txtUserName.SetFocus
ElseIf Data1.Recordset!id_apoteker <> txtPassword.Text Then
MsgBox "Invalid Password?", vbOKOnly, "Informasi"
txtPassword.SetFocus
Else
MDIForm1.Show
kode = txtUserName.Text
Unload Me
Me.Hide
End If
End Sub

nie wat listing form pembayaran + resep

Private Sub DBGrid1_DblClick()
If sementara.Recordset.RecordCount = 0 Then
MsgBox "Tidak Ada yang Bisa Dihapus Lagi!", vbOKOnly + vbCritical, "Konfirmasi"
Exit Sub
End If
x = MsgBox("Yakin Data Mau Dihapus", vbYesNo + 32, "Konfirmasi")
If x = vbYes Then
On Error Resume Next
obat.Recordset.Index = "id_obat"
obat.Recordset.Seek "=", sementara.Recordset!kode_obat
If Not obat.Recordset.NoMatch Then
obat.Recordset.Edit
obat.Recordset!jumlah = va(obat.Recordset!jumlah) + Val(sementara.Recordset!qty)
obat.Recordset.Update
obat.Refresh
End If
If sementara.Recordset.RecordCount > 0 Then
sementara.Recordset.Delete
End If
Call total_harga
Else
Exit Sub
End If
End Sub


Private Sub cmdadd_Click()
If txtqty = "" Then
MsgBox "Data Masih Ada yang Kosong Tuchh, Silakan di Isi dulu", vbInformation, "Iformation"
txtqty.SetFocus
Else
sementara.Recordset.AddNew
sementara.Recordset!kode_obat = DBCombo2.Text
sementara.Recordset!nama_obat = txtnm.Text
sementara.Recordset!hargasat = txthrg.Text
sementara.Recordset!qty = txtqty.Text
sementara.Recordset!jmlhbyr = txtjmlbyr.Text
sementara.Recordset.Update
Call total_harga
With obat.Recordset
.Edit
!jumlah = Val(!jumlah) - Val(txtqty.Text)
.Update
End With
DBCombo2.Text = "Obat"
txtnm.Text = ""
txthrg.Text = ""
txtqty.Text = ""
txtjmlbyr.Text = ""
DBCombo2.SetFocus
End If
End sub


Private Sub cmdcancel_Click()
If sementara.Recordset.RecordCount = 0 Then
MsgBox "Tidak ada yang bisa dihapus lagi!", vbOKOnly + vbCritical, "Konfirmasi"
Exit Sub
End If
x = InputBox("Masukkan ID Obat yang Akan Dibatalkan", "Konfirmasi")
On Error Resume Next
sementara.Recordset.Index = "kode_obat"
sementara.Recordset.Seek "=", UCase(x)
If Not sementara.Recordset.NoMatch Then
sementara.Recordset.Delete
End If
Call total_harga
End Sub


Private Sub cmdsave_Click()
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Load printer
printer.Show
printer.FontName = "arial"
printer.CurrentX = 0
printer.CurrentY = 0
printer.FontSize = 12
printer.FontBold = False
printer.Print
printer.Print Tab(3); "Apotek Segera Sembuh"
printer.Print Tab(3); "Jl. Kompleks PLN P3B"
printer.Print
printer.FontSize = 8
printer.FontUnderline = False
printer.Print Tab(3); "Struk Obat"
printer.Print
printer.FontSize = 8
printer.FontUnderline = False
printer.Print Tab(3); "No. nota :"; Tab(35); txtidnota.Text
printer.Print Tab(3); "Tanggal :"; Tab(35); txttgl.Text
printer.Print Tab(3); "ID Apoteker :"; Tab(35); Text3.Text
printer.Print
printer.FontBold = False
printer.Print String(80, "=")
printer.FontBold = False
printer.Print Tab(3); "Kode Obat"; Tab(15); "Nama Obat"; Tab(27); "Jumlah"; Tab(39); "Harga"; Tab(51); "Bayar";
printer.FontBold = False
With sementara.Recordset
.MoveFirst
n = 1
While Not .EOF
a = sementara.Recordset!kode_obat
e = sementara.Recordset!nama_obat
f = sementara.Recordset!qty
g = sementara.Recordset!hargasat
h = sementara.Recordset!jmlhbyr
i = sementara.Recordset!jmlhbyr + i
If Not sementara.Recordset!kode_obat = Space(15) Then
nota.Recordset.AddNew
nota.Recordset!id_nota = txtidnota.Text
nota.Recordset!tgl_nota = txttgl.Text
nota.Recordset!jml_beli = sementara.Recordset!qty
nota.Recordset!harga = sementara.Recordset!hargasat
nota.Recordset!total_bayar = txttot.Text
nota.Recordset!id_cost = DBCombo1.Text
nota.Recordset!id_apteker = Text3.Text
nota.Recordset!id_obt = DBCombo2.Text
nota.Recordset.Update

End If
printer.Print Tab(3); Format(a, "###"); Tab(15); Format(e, "###"); Tab(27); Format(f, "###"); Tab(39); Format(g, "###"); Tab(51); Format(h, "###");
.MoveNext
n = n + 1
Wend
End With
printer.FontBold = False
printer.Print Tab(1); String(80, "=")
printer.FontBold = False
printer.Print Tab(51); "Total bayar:"; Tab(65); Format(i, "###,###,###")
printer.Print Tab(51); "Uang Bayar:"; Tab(65); Format(txtbyr.Text, "###,###,###")
b = Val(txtbyr.Text) - i
If b = 0 Then
b = "0"
End If
printer.Print Tab(51); "Uang Kembali:"; Tab(65); Format(b, "###,###,###")
printer.Print Tab(1); String(80, "=")
printer.Print Tab(3); "Terima kasih"
'printer.EndDoc
Z = MsgBox("Cetak Print?", vbYesNo, "Informasi")
If Z = vbYes Then
End If
If sementara.Recordset.RecordCount > 0 Then
sementara.Recordset.MoveFirst
Do While Not sementara.Recordset.EOF
sementara.Recordset.Delete
sementara.Recordset.MoveNext
Loop
End If
Call bersih
End Sub



Private Sub form_activate()
DBCombo2.SetFocus
Call Timer1_Timer
Call nomor
txtidnota.Enabled = False
txttgl.Enabled = False
Text3.Enabled = False
Text3.Text = apoteker.Recordset!id_apoteker
txttot.Text = ""
txtbyr.Text = ""
txtkmbl.Text = ""
End Sub
Private Sub Timer1_Timer()
txttgl.Text = Date
txtjam.Text = Time
End Sub

Private Sub txtbyr_Change()
txtkmbl.Text = Val(txtbyr.Text) - Val(txttot.Text)
End Sub

Private Sub txtqty_Change()
If Val(obat.Recordset!jumlah) = 0 Then
MsgBox "Maaf Stok Obat Kosong", vbInformation, "Informasi"
Exit Sub
End If
If Val(txtqty.Text) > Val(obat.Recordset!jumlah) Then
MsgBox "Maaf Stok Obat Tidak Mencukupi", vbInformation, "Informasi"
txtqty.Text = ""
Exit Sub
End If
txtjmlbyr.Text = Val(txtqty.Text) * Val(txthrg.Text)
End Sub

Private Sub txtqty_KeyPress(KeyAscii As Integer)
If Not (KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Or KeyAscii = vbKeyBack) Then KeyAscii = 0
End Sub