MODUL VB APOTIK
MERCUSUAR
FORM LOGIN Form ini yang pertama kali dipanggil atau dieksekusi oleh program sebelum form lain. Jika Password benar maka akan buka Form Menu, jika salah sampai 3 kali maka program akan keluar. FORM LAYOUT
PROPERTY SETTING No. 1
Object Form
2
Label1
3 4 5
Label2 Label3 Textbox1
6
Textbox2
7
Command1
8
Command2
Property Name Caption Caption Font Caption Caption Name Text Name Text Name Caption Name Caption
Setting frmLogin Login System Login System Times New Roman (12)+Bold Nama User Password txtUser txtPass cmdOK OK cmdKeluar Keluar
CODE: Option Explicit Dim pass As String Dim x As Integer Private Sub cmdKeluar_Click() End End Sub Private Sub cmdOK_Click() If txtUser = "" Then MsgBox "Nama User harus diisi!", vbOKOnly + vbCritical, "Salah" End If CekPass End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Private Sub CekPass() If txtPass = pass Then MsgBox "AKSES DITERIMA ! Selamat Datang, " & UCase(txtUser), , "OK" Unload Me frmMenu.Show (1) Else If x = 3 Then MsgBox "Anda tidak berhak mengoperasikan aplikasi ini!", vbOKOnly + vbCritical, "UnAuthorized" End Else MsgBox "Password SALAH, masukkan lagi Passwordnya!" & Chr(10) & _ "Kesempatan anda " & 3 - x & " lagi", vbOKOnly + vbCritical, "Password Salah" x = x + 1 txtPass = "" txtPass.SetFocus Exit Sub End If End If End Sub Private Sub Form_Activate() pass = "mercu" txtUser.SetFocus x = 1 End Sub Private Sub txtPass_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdOK_Click End If End Sub Private Sub txtUser_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtPass.SetFocus End If End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
FORM MENU Cara Membuat Menu : 1. Buatlah baru, klik menu Tool, pilih Menu Editor, muncul….
2. Pada bagian Caption, ketik File, bagian Name, ketik mnFile, maka menu File tercipta (lihat bagian bawah (putih) dari gambar diatas. 3. Klik dibagian bawah File, kemudian klik tombol tanda panah kanan. Pada bagian Caption, ketik Data Obat, bagian Name, ketik mnObat, maka submenu File tercipta. Ulangi lagi langkah ini membuat submenu Exit (Caption : Exit, Name : mnExit) 4. Klik bagian bawah Exit. Bagian Caption, ketik Transaksi, bagian Name, ketik mnTrans, maka menu Transaksi tercipta. 5. Klik dibagian bawah Transaksi, kemudian klik tombol tanda panah kanan. Pada bagian Caption, ketik Penjualan Obat, bagian Name, ketik mnJual, maka submenu Transaksi tercipta. 6. Klik bagian bawah Penjualan Obat. Bagian Caption, ketik Laporan, bagian Name, ketik mnLap, maka menu Laporan tercipta. 7. Klik dibagian bawah Laporan, kemudian klik tombol tanda panah kanan. Pada bagian Caption, ketik Daftar Obat, bagian Name, ketik mnDO, maka submenu Laporan tercipta. Ulangi lagi langkah ini membuat submenu Laporan Penjualan (Caption : Laporan Penjualan, Name : mnLapJual). 8. Bila sudah jadi maka seperti gambar diatas. Akhiri dengan tekan OK, maka hasilnya seperti…
CODE : Private Sub Form_Activate() Me.WindowState = 2 End Sub Private Sub mnDO_Click() frmListObat.Show (1)
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
End Sub Private Sub mnExit_Click() End End Sub Private Sub mnJual_Click() frmJual.Show (1) End Sub Private Sub mnObat_Click() frmObat.Show (1) End Sub Private Sub mnLapJual_Click() frmLapJual.Show (1) End Sub Private Sub Timer1_Timer() Me.Caption = "Apotik Sehat Selalu :: Menu :: " & Format(Now, "dd mmmm yyyy") & " " & Time$ End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
FORM OBAT (Aplikasi Koneksi Database secara Program) Program ini membutuhkan objek tambahan yaitu : 1. Microsoft Ado Data Control 6.0 (OLEDB) 2. Microsoft DataGrid Control 6.0 (OLEDB) 3. Microsoft Windows Common Controls-2 6.0 Tambahkan objek diatas dengan memilih menu Project, Component, dan tandai objek-objek diatas serta akhiri dengan tekan OK. Selain membutuhkan objek diatas, program ini membutuhkan module yang bernama Connection, lakukan langkah berikut ini : Klik menu Project, pilih Add Module, klik tombol Open, kemudian, ketik isi modul dibawah ini : Public conn As New ADODB.Connection Public rsObat As New ADODB.Recordset Public rsJual As New ADODB.Recordset Public rsDump As New ADODB.Recordset Public NmDatabase As String Sub Main() NmDatabase = App.Path + "\Apotik.mdb" On Error Resume Next If conn.State = 1 Then conn.Close conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NmDatabase & ";Persist Security Info=False" End Sub Public Function RKanan(NData, CFormat) As String 'fungsi untuk format rata kanan suatu data numerik RKanan = Format(NData, CFormat) RKanan = Space(Len(CFormat) - Len(RKanan)) + RKanan End Function
Pada bagian Property, setting Name menjadi Connection, dan simpan dengan nama yang sama yaitu Connection FORM LAYOUT
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
PROPERTY SETTING No
Object
1
Form1
2
Label1
Property
Setting
No
Object
Name
frmObat
16
Text5
Caption Caption
Form Data Obat APOTIK SEHAT SELALU
Font
TimesNewRoman (10)
Property
Setting
Name
txtHargaJual
Text
17
Text6
Alignment
1RighJustify
Name
txtStok
3
Label2
Caption
Kode Obat
4
Label3
Caption
Nama Obat
5
Label4
Caption
Satuan
6
Label5
Caption
Bentuk Obat
7
Label6
Caption
Exp. Date
8
Label7
Caption
Harga Beli
20
DTPicker
Name
ExpDate
21
Command1
Name
cmdBaru
Caption
Baru
Name
cmdEdit
Caption
Edit
Name
cmdHapus
9
Label8
Caption
Keuntungan %
10
Label9
Caption
Harga Jual
11
Label10
Caption
Stok Obat
12
Text1
Name
txtKode
Text
By Agus .SM, S.Kom
Text 18
Combo1
Name
19
Combo2
Name
cboSatuan
Text cboBentuk
Text
22 23
Command2 Command3
[email protected]
MODUL VB APOTIK
13
Text2
Name
txtNama
Text 14
Text3
Name
24 txtHargaBeli
Text 15
Text4
Command4
25
Alignment
1-RightJustify
Name
txtUntung
26
Command5 Command6
Text Alignment
1-RightJustify
MERCUSUAR
Caption
Hapus
Name
cmdBatal
Caption
Batal
Name
cmdDaftar
Caption
Daftar Obat
Name
cmdKeluar
Caption
Keluar
27
Adodc1
Name
Adodc1
28
DataGrid1
Name
DG
CODE : Option Explicit Dim rsShow As New ADODB.Recordset Private Sub Form_Activate() cboSatuan.AddItem "Strip" cboSatuan.AddItem "Botol" cboSatuan.AddItem "Ampul" cboSatuan.AddItem "Box" cboBentuk.AddItem "Tablet" cboBentuk.AddItem "Kaplet" cboBentuk.AddItem "Kapsul" cboBentuk.AddItem "Sirup" cboBentuk.AddItem "Oral" cboBentuk.AddItem "Tetes" Pasif txtKode.MaxLength = 5 cmdEdit.Enabled = False cmdHapus.Enabled = False cmdBatal.Enabled = False cmdDaftar_Click cmdBaru.SetFocus End Sub Private Sub Form_Load() Connection.Main With rsShow .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NmDatabase & ";Persist Security Info=False" .CursorLocation = adUseClient .LockType = adLockOptimistic .CursorType = adOpenStatic .Source = "SELECT Kode,NamaObat,Jenis,ExpDate,HargaJual,Stok From Obat Order by NamaObat asc" .Open End With End Sub Private Sub cmdBaru_Click() If cmdBaru.Caption = "Baru" Then cmdBaru.Caption = "Simpan" 'Aktif Blank cmdBatal.Enabled = True
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
txtKode.Enabled = True txtKode.SetFocus Else cmdBaru.Caption = "Baru" Call Simpan Pasif cmdBatal.Enabled = False End If End Sub Sub Simpan() With rsObat If .State = 1 Then .Close .Open "Select * From Obat", conn, adOpenKeyset, adLockOptimistic .AddNew .Fields("Kode") = txtKode .Fields("NamaObat") = txtNama .Fields("Satuan") = cboSatuan .Fields("Jenis") = cboBentuk .Fields("ExpDate") = Format(ExpDate, "dd/mm/yyyy") .Fields("HargaBeli") = txtHargaBeli .Fields("Keuntungan") = txtUntung .Fields("HargaJual") = txtHargaJual .Fields("Stok") = txtStok .Update End With cmdDaftar_Click End Sub Private Sub cmdBatal_Click() Blank cmdBaru.Caption = "Baru" cmdEdit.Caption = "Edit" cmdBaru.Enabled = True cmdEdit.Enabled = False cmdHapus.Enabled = False cmdBatal.Enabled = False Pasif DG.Visible = False cmdBaru.SetFocus End Sub Private Sub cmdDaftar_Click() If cmdDaftar.Caption = "Daftar Obat" Then cmdDaftar.Caption = "Tutup Daftar" DG.Visible = True With rsShow If .State = 1 Then .Close .Source = "SELECT Kode,NamaObat,Jenis,ExpDate,HargaJual,Stok From Obat Order by NamaObat asc" .Open End With Set DG.DataSource = rsShow DG.Refresh Else cmdDaftar.Caption = "Daftar Obat" DG.Visible = False End If End Sub Private Sub cmdEdit_Click() With rsObat
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
If .State = 1 Then .Close .Open "Select * From Obat where Kode='" & txtKode & "'", conn, adOpenKeyset, adLockOptimistic .Fields("NamaObat") = txtNama .Fields("Satuan") = cboSatuan .Fields("Jenis") = cboBentuk .Fields("ExpDate") = Format(ExpDate, "dd/mm/yyyy") .Fields("HargaBeli") = txtHargaBeli .Fields("Keuntungan") = txtUntung .Fields("HargaJual") = txtHargaJual .Fields("Stok") = txtStok .Update End With cmdDaftar_Click cmdBatal_Click End Sub Private Sub cmdHapus_Click() If MsgBox("Benar data obat " & UCase(txtNama) & " mau dihapus?", vbYesNo + vbQuestion, "Hapus") = vbYes Then With rsObat If .State = 1 Then .Close .Open "Select * From Obat where Kode='" & txtKode & "'", conn, adOpenKeyset, adLockOptimistic .Delete End With End If cmdBatal_Click End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub DG_DblClick() txtKode = DG.Columns(0).Value End Sub Sub Pasif() txtKode.Enabled = False txtNama.Enabled = False cboSatuan.Enabled = False cboBentuk.Enabled = False ExpDate.Enabled = False txtHargaBeli.Enabled = False txtUntung.Enabled = False txtHargaJual.Enabled = False txtStok.Enabled = False End Sub Sub Aktif() txtKode.Enabled = True txtNama.Enabled = True cboSatuan.Enabled = True cboBentuk.Enabled = True ExpDate.Enabled = True txtHargaBeli.Enabled = True txtUntung.Enabled = True txtHargaJual.Enabled = True txtStok.Enabled = True End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Sub Blank() txtKode = "" txtNama = "" cboSatuan = "" cboBentuk = "" ExpDate = Now txtHargaBeli = "" txtUntung = "" txtHargaJual = "" txtStok = "" End Sub Private Sub txtHargaBeli_Change() txtHargaJual = Val(txtHargaBeli) + (Val(txtHargaBeli) * Val(txtUntung) / 100) End Sub Private Sub txtUntung_Change() txtHargaJual = Val(txtHargaBeli) + (Val(txtHargaBeli) * Val(txtUntung) / 100) End Sub Private Sub txtKode_Change() If Len(txtKode) < 5 Then Exit Sub With rsObat If .State = 1 Then .Close .Open "Select * From Obat Where Kode='" & txtKode & "'", conn, adOpenKeyset, adLockOptimistic If .RecordCount > 0 Then txtNama = .Fields("NamaObat") cboSatuan = .Fields("Satuan") cboBentuk = .Fields("Jenis") txtHargaBeli = .Fields("HargaBeli") txtHargaJual = .Fields("HargaJual") txtUntung = .Fields("Keuntungan") txtStok = .Fields("Stok") ExpDate = .Fields("Expdate") If MsgBox("Kode Obat Sudah terpakai. Mau Edit Data", vbYesNo + vbQuestion, "Kode Obat") = vbYes Then Aktif txtKode.Enabled = False txtNama.SetFocus cmdBaru.Caption = "Baru" cmdBaru.Enabled = False cmdBatal.Enabled = True cmdEdit.Enabled = True cmdHapus.Enabled = True cmdEdit.Caption = "Update" Exit Sub Else cmdBatal_Click End If End If End With Aktif txtKode.Enabled = False txtNama.SetFocus End Sub Private Sub txtNama_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboSatuan.SetFocus End If End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Private Sub cboSatuan_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cboBentuk.SetFocus End If End Sub Private Sub cboBentuk_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then ExpDate.SetFocus End If End Sub Private Sub ExpDate_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 13 Then txtHargaBeli.SetFocus End If End Sub Private Sub txtHargaBeli_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtUntung.SetFocus End If End Sub Private Sub txtUntung_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtStok.SetFocus End If End Sub Private Sub txtStok_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then If cmdBaru.Enabled = True Then cmdBaru.SetFocus Else cmdEdit.SetFocus End If End If End Sub Private Sub txtKode_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
MODUL PENJUALAN OBAT Untuk membuat program dibawah ini perlu ditambahkan objek baru yaitu ListView. Lakukan langkah berikut ini : Klik menu Project, pilih Components, gulung ke bawah, tandai Microsoft Windows Common Control 6.0 (SP6), kemudian klik tombol OK. FORM LAYOUT
PROPERTY SETTING No
Object
Property
Setting
No
Object
Property
Setting
1
Form1
Name
frmJual
17
Textbox5
Name
txtJumlah
Caption 2
Label1
Caption
Transaksi Penjualan Apotik SEHAT SELALU
Text
3
Label2
Caption
No.Faktur
4
Label3
Caption
Kode Obat
5
Label4
Caption
Tanggal
Text
6
Label5
Caption
Jumlah Beli
Locked
TRUE
Name
txtTotal
18
Textbox6
Name
19
Textbox7
Name
txtDisc
Text
7
Label6
Caption
Discount (%)
8
Label7
Caption
>>> Enter
Text
9
Label8
Caption
Jam
Locked
TRUE
10
Label9
Caption
Total
txtBayar
11
Label10
Caption
Bayar
12
Label11
Caption
Kembali
By Agus .SM, S.Kom
20
Textbox8
txtJam
21
Textbox9
Name
22
Textbox10
Name
Text txtKembali
[email protected]
MODUL VB APOTIK
13
Textbox1
Name
txtNoFak
Text
Text 14
Textbox2
15
Textbox3
Textbox4
TRUE
TRUE
23
Timer1
Interval
100
Name
txtKode
24
ListView1
Name
lstJual
25
Command1
Name
cmdReset
Caption
Reset
Name
cmdCetak Simpan (Cetak)
Name
txtNama
Text
16
Locked
Locked Text
26
Locked
TRUE
Name
txtTgl
MERCUSUAR
Command2
Caption
Text Locked
TRUE
CODE: Option Explicit Dim rsShow As New ADODB.Recordset Dim vbnofak As String Dim vbharga, vbtotal As Single Dim List As ListItem Dim header As ColumnHeader Private Sub HeaderJual() Set header = lstJual. _ ColumnHeaders.Add(, , "No", 500) Set header = lstJual. _ ColumnHeaders.Add(, , "Kode", 700) Set header = lstJual. _ ColumnHeaders.Add(, , "Nama Barang", 3000) Set header = lstJual. _ ColumnHeaders.Add(, , "QTY", 600, 1) Set header = lstJual. _ ColumnHeaders.Add(, , "Harga", 1200, 1) Set header = lstJual. _ ColumnHeaders.Add(, , "Disc%", 700, 1) Set header = lstJual. _ ColumnHeaders.Add(, , "PJualan", 1500, 1) End Sub Private Sub ListJual() Dim no As Integer no = 1 vbtotal = 0 lstJual.View = lvwReport With rsDump If .State = 1 Then .Close .Open "Select * From dumpJual", conn, adOpenKeyset, adLockOptimistic lstJual.ListItems.Clear '.MoveFirst
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Do While Not .EOF On Error Resume Next Set List = lstJual.ListItems.Add(, , no) List.SubItems(1) = .Fields("Kode") List.SubItems(2) = .Fields("Nama") List.SubItems(3) = .Fields("Jumlah") List.SubItems(4) = Format(.Fields("Harga"), "##,###,##") List.SubItems(5) = .Fields("Disc") List.SubItems(6) = Format(.Fields("Pjual"), "##,###,##") vbtotal = vbtotal + .Fields("Pjual") .MoveNext no = no + 1 Loop End With txtTotal = Format(vbtotal, "###,###,###") End Sub Private Sub Form_Load() Connection.Main End Sub Private Sub Form_Activate() txtTgl = Format(Now, "dd mmmm yyyy") Hapus HeaderJual ListJual CekNofak txtKode.SetFocus End Sub Sub SimpanTransaksi() Dim pj As Single With rsDump If .State = 1 Then .Close .Open "Select * From dumpJual", conn, adOpenKeyset, adLockOptimistic .AddNew .Fields("Kode") = txtKode .Fields("Nama") = txtNamaObat .Fields("Jumlah") = txtJumlah .Fields("Disc") = Val(txtDisc) .Fields("Harga") = vbharga pj = Val(txtJumlah) * vbharga .Fields("Pjual") = pj - (pj * Val(txtDisc) / 100) .Update End With txtKode = "" txtNamaObat = "" txtJumlah = "" txtDisc = "" ListJual txtKode.SetFocus End Sub Sub SalinPenjualan() With rsJual If .State = 1 Then .Close .Open "Select * From Jual", conn, adOpenKeyset, adLockOptimistic If rsDump.State = 1 Then rsDump.Close rsDump.Open "Select * From dumpJual", conn, adOpenKeyset, adLockOptimistic If rsDump.RecordCount = 0 Then
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
MsgBox "Tidak ada Transaksi", vbOKOnly + vbCritical, "Transaksi" Exit Sub End If rsDump.MoveFirst Do While Not rsDump.EOF 'salin dari dump ke jual .AddNew .Fields("Kode") = rsDump.Fields("Kode") .Fields("Nofak") = txtNoFak .Fields("Jumlah") = rsDump.Fields("Jumlah") .Fields("Disc") = rsDump.Fields("Disc") .Fields("TglJual") = Format(Now, "dd/mm/yyyy") .Update 'Update Stok Obat If rsObat.State = 1 Then rsObat.Close rsObat.Open "Select * From Obat Where Kode='" & rsDump.Fields("Kode") & "'", conn, adOpenKeyset, adLockOptimistic rsObat.Fields("Stok") = rsObat.Fields("Stok") - rsDump.Fields("Jumlah") rsObat.Update rsDump.MoveNext Loop End With End Sub Private Sub txtKode_Change() If Len(txtKode) < 5 Then Exit Sub With rsObat If .State = 1 Then .Close .Open "Select * From Obat where Kode='" & txtKode & "'", conn, adOpenKeyset, adLockOptimistic If .RecordCount = 0 Then MsgBox "Kode obat tidak dikenal !", vbOKOnly + vbCritical, "Kode Salah" txtKode.SetFocus Exit Sub End If txtNamaObat = .Fields("NamaObat") vbharga = .Fields("HargaJual") txtJumlah.SetFocus End With End Sub Private Sub cmdCetak_Click() SalinPenjualan If MsgBox("Mau dicetak?", vbYesNo + vbQuestion, "Cetak") = vbYes Then CetakSlip End If CekNofak cmdReset_Click End Sub Private Sub cmdReset_Click() txtKode = "" txtNamaObat = "" txtJumlah = "" txtDisc = "" txtTotal = "" txtBayar = "" txtkembali = "" Hapus ListJual txtKode.SetFocus End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Sub CekNofak() Dim n As Single Dim t, b, h As String t = Format(Now, "yyyy") b = Format(Now, "mm") h = Format(Now, "dd") With rsJual If .State = 1 Then .Close .Open "Select * From Jual order by Nofak asc", conn, adOpenKeyset, adLockOptimistic If .RecordCount > 0 Then .MoveLast n = Mid(Val(.Fields("Nofak")), 9, 2) vbnofak = t + b + h & n + 1 Else vbnofak = t + b + h & "1" End If End With txtNoFak = vbnofak End Sub Sub Hapus() With rsDump If .State = 1 Then .Close .Open "Select * From dumpJual", conn, adOpenKeyset, adLockOptimistic If .RecordCount > 0 Then .MoveFirst Do While Not .EOF .Delete .MoveNext Loop End If End With End Sub Private Sub Timer1_Timer() txtJam = Format(Now, "hh:mm:ss") & " WIB" End Sub Private Sub txtBayar_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtkembali = Round(Val(txtBayar) - vbtotal) cmdCetak.SetFocus End If End Sub Private Sub txtJumlah_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then txtDisc.SetFocus End If End Sub Private Sub txtDisc_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then SimpanTransaksi End If End Sub Private Sub txtKode_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then If MsgBox("Transaksi selesai ?", vbYesNo + vbQuestion, "Selesai") = vbYes Then
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
txtBayar.SetFocus Else txtKode.SetFocus End If End If End Sub Sub CetakSlip() Dim ttl As Single Printer.Print Printer.Print Printer.Print Tab(5); "APOTIK SEHAT SELALU" Printer.Print Tab(5); "Jl. Seger Waras 10" Printer.Print Printer.Print Tab(5); "Faktur Pembelian" Printer.Print Tab(5); "Tanggal : "; Format(Now, "dd/mm/yyyy hh:mm:ss") Printer.Print Tab(5); String(80, "-") Printer.Print Tab(5); "Nama Obat"; Printer.Print Tab(35); "QTY"; Printer.Print Tab(42); "Harga"; Printer.Print Tab(52); "Total" Printer.Print Tab(5); String(80, "-") ttl = 0 With rsDump If .State = 1 Then .Close .Open "Select * From dumpjual", conn, adOpenKeyset, adLockOptimistic .MoveFirst Do While Not .EOF Printer.Print Tab(5); .Fields("Nama"); Printer.Print Tab(35); RKanan(.Fields("Jumlah"), "###"); Printer.Print Tab(42); RKanan(.Fields("Harga"), "#,###,###"); Printer.Print Tab(52); RKanan(.Fields("Pjual"), "#,###,###") ttl = ttl + .Fields("Pjual") .MoveNext Loop End With Printer.Print Tab(5); String(80, "-") Printer.Print Tab(30); "Grand Total"; Tab(52); RKanan(ttl, "#,###,###") Printer.Print Tab(30); "Bayar"; Tab(52); RKanan(Val(txtBayar), "#,###,###") Printer.Print Tab(30); "Kembalian"; Tab(52); RKanan(Val(txtkembali), "#,###,###") Printer.Print Tab(52); "Terima kasih" Printer.EndDoc End Sub
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
FORM DAFTAR OBAT Untuk membuat program dibawah ini perlu ditambahkan objek baru yaitu ListView. Lakukan langkah berikut ini : Klik menu Project, pilih Components, gulung ke bawah, tandai Microsoft Windows Common Control 6.0 (SP6), kemudian klik tombol OK. FORM LAYOUT
PROPERTY SETTING No
Object
Property
Setting
1
Form1
Name
frmListObat
Caption 2
Frame1
Caption
Daftar Obat :: Filter Data Obat ::
3
Label1
Caption
Nama Obat
4
Label2
Caption
Jenis Obat
5
Textbox1
Name
txtNama
Text1 6
Combo1
Name
cboJenis
Text1 7
Command1
Name
cmdShow
Caption
:: Show
No 8
9
Object
Property
Setting
Command2
Name
cmdCetak
Caption
:: Cetak
Name
cmdRefresh
Caption
:: Refresh
Name
cmdKeluar
Command3
10
Command4
Caption
:: Keluar
11
ListView
Name
12
Label3
Caption
lstObat Jumlah Item Obat
13
Textbox2
Name
txtJml
Text1
CODE By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
Option Explicit Dim rsShow As New ADODB.Recordset Dim List As ListItem Dim header As ColumnHeader Private Sub HeaderObat() Set header = lstObat. _ ColumnHeaders.Add(, , "No", 500) Set header = lstObat. _ ColumnHeaders.Add(, , "Kode", 800) Set header = lstObat. _ ColumnHeaders.Add(, , "Nama Obat", 3000) Set header = lstObat. _ ColumnHeaders.Add(, , "Satuan/Jenis", 1500) Set header = lstObat. _ ColumnHeaders.Add(, , "Harga", 1200, 1) Set header = lstObat. _ ColumnHeaders.Add(, , "Stok", 700, 1) Set header = lstObat. _ ColumnHeaders.Add(, , "ExpDate", 1100, 1) End Sub Private Sub ListObat() Dim no, vbtotal As Integer no = 1: vbtotal = 0 lstObat.View = lvwReport lstObat.GridLines = True lstObat.FullRowSelect = True With rsObat If .State = 1 Then .Close If txtNama <> "" And cboJenis <> "" Then .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From where NamaObat LIKE '%" & Trim(txtNama) & "%' and jenis='" & cboJenis & "' order NamaObat Asc", conn, adOpenKeyset, adLockOptimistic ElseIf txtNama <> "" Then .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From where NamaObat LIKE '%" & Trim(txtNama) & "%' order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic ElseIf cboJenis <> "" Then .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From where jenis='" & cboJenis & "' order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic Else .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic End If lstObat.ListItems.Clear .MoveFirst Do While Not .EOF On Error Resume Next Set List = lstObat.ListItems.Add(, , no) List.SubItems(1) = .Fields("Kode") List.SubItems(2) = .Fields("NamaObat") List.SubItems(3) = .Fields("Satuan") & "/" & .Fields("Jenis") List.SubItems(4) = Format(.Fields("HargaJual"), "##,###,##")
By Agus .SM, S.Kom
Obat by
Obat
Obat
Obat
[email protected]
MODUL VB APOTIK
MERCUSUAR
List.SubItems(5) = .Fields("Stok") List.SubItems(6) = .Fields("ExpDate") vbtotal = vbtotal + 1 .MoveNext no = no + 1 Loop End With txtJml = Format(vbtotal, "###") End Sub Private Sub cmdCetak_Click() If MsgBox("Printer sudah siap?", vbYesNo + vbQuestion, "Cetak") = vbYes Then Call Cetak End If End Sub Private Sub cmdKeluar_Click() Unload Me End Sub Private Sub cmdRefresh_Click() txtNama = "" cboJenis = "" ListObat End Sub Private Sub cmdShow_Click() ListObat End Sub Private Sub Form_Activate() cboJenis.AddItem "Tablet" cboJenis.AddItem "Kaplet" cboJenis.AddItem "Sirup" cboJenis.AddItem "Kapsul" cboJenis.AddItem "Oral" cboJenis.AddItem "Tetes" HeaderObat ListObat End Sub Private Sub Form_Load() Connection.Main End Sub Sub Cetak() Dim no, ttl As Integer no = 1: ttl = 0 With rsObat If .State = 1 Then .Close If txtNama <> "" And cboJenis <> "" Then .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From Obat where NamaObat LIKE '%" & Trim(txtNama) & "%' and jenis='" & cboJenis & "' order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic ElseIf txtNama <> "" Then .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From Obat where NamaObat LIKE '%" & Trim(txtNama) & "%' order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic ElseIf cboJenis <> "" Then
By Agus .SM, S.Kom
[email protected]
MODUL VB APOTIK
MERCUSUAR
.Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From Obat where jenis='" & cboJenis & "' order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic Else .Open "Select Kode,NamaObat,Satuan,Jenis,HargaJual,Stok,expDate From Obat order by NamaObat Asc", conn, adOpenKeyset, adLockOptimistic End If Call Judul .MoveFirst Do While Not .EOF Printer.Print Tab(5); Format(no, "##"); Printer.Print Tab(8); .Fields("Kode"); Printer.Print Tab(15); .Fields("NamaObat"); Printer.Print Tab(45); .Fields("Satuan") & "/" & .Fields("Jenis"); ";" Printer.Print Tab(60); .Fields("HargaJual"); Printer.Print Tab(72); .Fields("Stok"); Printer.Print Tab(82); .Fields("ExpDate") no = no + 1 ttl = ttl + 1 .MoveNext Loop End With Printer.Print Tab(5); String(100, "-") Printer.Print Tab(50); "Jumlah Item Obat : "; Format(ttl, "###") Printer.EndDoc End Sub Sub Judul() Printer.Print Printer.Print Printer.Font = "Times New Roman": Printer.Font.Size = 12 Printer.Print Tab(5); "APOTIK SEHAT SELALU" Printer.Font = "Courier New": Printer.Font.Size = 9 Printer.Print Tab(5); "Jl. Seger Waras No.10" Printer.Print Printer.Print Tab(25); "DAFTAR OBAT" Printer.Print Tab(5); String(100, "-") Printer.Print Tab(5); "No"; Printer.Print Tab(8); "Kode"; Printer.Print Tab(15); "Nama Obat"; Printer.Print Tab(45); "Sat/Jenis"; Printer.Print Tab(60); "Harga"; Printer.Print Tab(72); "Stok"; Printer.Print Tab(82); "ExpDate" Printer.Print Tab(5); String(100, "-") End Sub
By Agus .SM, S.Kom
[email protected]
