1.
Kursus Komputer
Public bvb, bfox, bdel, bcplus, biaya As Double
Private Sub Ccpl_Click()
If Ccpl = 1 Then
bcplus = 125000
Else
bcplus = 0
End If
rumus
Txtbayar.SetFocus
End Sub
Private Sub Cdelp_Click()
If Cdelp = 1 Then
bdel = 150000
Else
bdel = 0
End If
rumus
Txtbayar.SetFocus
End Sub
Private Sub Cfoxp_Click()
If Cfoxp = 1 Then
bfox = 75000
Else
bfox = 0
End If
rumus
Txtbayar.SetFocus
End Sub
Private Sub Cmdkeluar_Click()
Unload Me
End Sub
Private Sub Cmdlagi_Click()
Form_Activate
End Sub
Private Sub Cvisb_Click()
If Cvisb = 1 Then
bvb = 100000
Else
bvb = 0
End If
rumus
Txtbayar.SetFocus
End Sub
Private Sub Form_Activate()
'--- Persiapan awal program
bvb = 0
bfox = 0
bdel = 0
bcplus = 0
'--- mematikan textbox
Txtnm.Enabled = False
Txtwkt.Enabled = False
Txtbkur.Enabled = False
Txtkembali.Enabled = False
'--- rata kanan textbox
Txtbkur.Alignment = 1
Txtbayar.Alignment = 1
Txtkembali.Alignment = 1
'--- nilai awal objek
Txtbayar = ""
Txtbkur = ""
Txtkembali = ""
Txtnm = ""
Txtwkt = ""
Ojad1.Value = False
Ojad2.Value = False
Ojad3.Value = False
Cvisb.Value = 0 '---uncehcked
Cfoxp.Value = 0 '---unchecked
Cdelp.Value = 0 '---unchecked
Ccpl.Value = 0 '---unchecked
'--- List Box No Peserta
listnmrp.Clear
listnmrp.AddItem "11111"
listnmrp.AddItem "22222"
listnmrp.AddItem "33333"
listnmrp.AddItem "44444"
listnmrp.AddItem "55555"
End Sub
Private Sub listnmrp_Click()
Select Case listnmrp.ListIndex
Case 0
Txtnm = "Emyana Br Sembiring"
Case 1
Txtnm = "Aditya Rifki Mediana"
Case 2
Txtnm = "Razuardi Ibrahim H.R"
Case 3
Txtnm = "Leonardo"
Case 4
Txtnm = "Abang Moulvy"
End Select
End Sub
Private Sub Ojad1_Click()
Txtwkt = "Pagi"
End Sub
Private Sub Ojad2_Click()
Txtwkt = "Siang"
End Sub
Private Sub Ojad3_Click()
Txtwkt = "Sore"
End Sub
Public Sub rumus()
biaya = bvb + bfox + bdel + bcplus
Txtbkur = Format(biaya, "Rp ##,###,###.00")
End Sub
Private Sub Txtbayar_Change()
Txtkembali = Val(Txtbayar) - Val(biaya)
Txtkembali = Format(Txtkembali, "Rp ##,###,###.00")
End Sub
2. Penggajian
Private Sub Text1_Change()
End Sub
Private Sub cbjabatan_Click()
If cbjabatan.Value = 1 Then
txtjabatan = 1000000
Else
txtjabatan = 0
End If
End Sub
Private Sub cbkeluarga_Click()
If cbkeluarga.Value = 1 Then
txtkeluarga = 1500000
Else
txtkeluarga = 0
End If
End Sub
Private Sub Cmdhitung_Click()
txtgaber = Val(txtgapok) + Val(txtjabatan) + Val(txtkeluarga)
End Sub
Private Sub Cmdkeluar_Click()
Unload Me
End Sub
Private Sub Cmdlagi_Click()
Form_Activate
End Sub
Private Sub cnip_Click()
Select Case cnip.ListIndex
Case 0
txtnm = "Naufal"
Case 1
txtnm = "Cah Bagus"
Case 2
txtnm = "Mas Ibrahimovik"
Case 3
txtnm = "Bang Do"
Case 4
txtnm = "Pogba"
End Select
End Sub
Private Sub Form_Activate()
'---- persiapan awal program
'--- menonaktifkan textbox
txtnm.Enabled = False
txtgapok.Enabled = False
txtgaber.Enabled = False
txtjabatan.Enabled = False
txtkeluarga.Enabled = False
'--- rata kanan textbox
txtgaber.Alignment = 1
txtgapok.Alignment = 1
txtjabatan.Alignment = 1
txtkeluarga.Alignment = 1
'--- nilai awal objek
txtgaber = ""
txtgapok = ""
txtjabatan = ""
txtkeluarga = ""
txtnm = ""
obdirektur.Value = False
obmanajer.Value = False
obsupervisor.Value = False
cbjabatan.Value = 0 '-- unchecked
cbkeluarga.Value = 0
'--- list combo box nip
cnip.Clear
cnip.AddItem "11111"
cnip.AddItem "22222"
cnip.AddItem "33333"
cnip.AddItem "44444"
cnip.AddItem "55555"
End Sub
Private Sub obdirektur_Click()
txtgapok = 5000000
End Sub
Private Sub obmanajer_Click()
txtgapok = 3000000
End Sub
Private Sub obsupervisor_Click()
txtgapok = 2000000
End Sub
3. Rumah Makan
Private Sub cmdbersih_Click()
obbpkt1.Value = False
obbpkt2.Value = False
obbpkt3.Value = False
txtbyr = ""
txtdisk = ""
txthrg = ""
txtmenu = ""
txtporsi = ""
txttot = ""
End Sub
Private Sub Cmdhitung_Click()
txttot = txtporsi * txthrg
If txtporsi > 5 Then
txtdisk = 0.1 * txttot
Else
txtdisk = 0
End If
txtbyr = txttot - txtdisk
End Sub
Private Sub Cmdkeluar_Click()
Unload Me
End Sub
Private Sub obbpkt1_Click()
txtmenu = "Sate Kerbau"
txthrg = 20000
txtporsi.SetFocus
End Sub
Private Sub obbpkt2_Click()
txtmenu = "Sate Sapi"
txthrg = 25000
txtporsi.SetFocus
End Sub
Private Sub obbpkt3_Click()
txtmenu = "Sate Ayam"
txthrg = 15000
txtporsi.SetFocus
End Sub
4. Barang
Public dbarang As New ADODB.Recordset
Public kembar As New ADODB.Recordset
Public Isi As Integer
Private Sub Cbcari_Click()
Txtcari = ""
Txtcari.SetFocus
End Sub
Private Sub Cmdbatal_Click()
Form_Activate
End Sub
Private Sub Cmdcari_Click()
Isian 0, 0, 1
Tombol 0, 0, 0, 0, 1, 1, 0, 1
bersih
Cbcari.SetFocus
End Sub
Private Sub Cmdhapus_Click()
p = "delete from barang where kdbrg='" & Txtkdbrg & "'"
If MsgBox("Yakin data ini akan dihapus?", vbQuestion + vbYesNo, "Hapus data") = vbYes Then
sambung.Execute (p)
End If
Form_Activate
End Sub
Private Sub Cmdkeluar_Click()
Unload Me
End Sub
Private Sub Cmdkoreksi_Click()
Isi = 2
Isian 0, 1, 0
Tombol 0, 0, 0, 1, 1, 0, 0, 0
Dgbarang.Enabled = False
Txtnmbrg.SetFocus
End Sub
Private Sub Cmdrefresh_Click()
p = "select * from barang order by kdbrg"
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
Txtjmldata = dbarang.RecordCount
Tampilan
Txtjmldata = dbarang.RecordCount
Cbcari = ""
Txtcari = ""
End Sub
Private Sub Cmdsimpan_Click()
If Isi = 1 Then
'--- validasi inputan kode barang
If Len(Txtkdbrg) < 5 Then
MsgBox "Inputan kode barang belum valid", vbInformation + vbOKOnly, "Ulangi"
Txtkdbrg = ""
Txtkdbrg.SetFocus
Else
'--- validasi data kembar (kode barang)
p = "select * from barang where kdbrg='" & Txtkdbrg & "'"
Set kembar = sambung.Execute(p)
If kembar.RecordCount <> 0 Then
MsgBox "Kode Barang Tersebut Sudah Ada", vbCritical + vbOKOnly, "Ulangi"
Txtkdbrg = ""
Txtkdbrg.SetFocus
Else
'--- Simpan data baru
p = "insert into barang values('" & Txtkdbrg & "','" & Txtnmbrg & "','" & Val(Txtstok) & "','" & Cbsat
& "','" & Val(Txthrgbl) & "','" & Val(Txthrgjl) & "')"
sambung.Execute (p)
Form_Activate
End If
End If
End If
If Isi = 2 Then
'--- simpan data koreksi
p = "update barang set nmbrg='" & Txtnmbrg & "'," & _
"stok='" & Txtstok & "'," & _
"satuan='" & Cbsat & "'," & _
"hrgbl='" & Txthrgbl & "'," & _
"hrgjl='" & Txthrgjl & "'" & _
" where kdbrg='" & Txtkdbrg & "'"
sambung.Execute (p)
Form_Activate
End If
End Sub
Private Sub Cmdtambah_Click()
Isi = 1
Isian 1, 1, 0
Tombol 0, 0, 0, 1, 1, 0, 0, 0
Dgbarang.Enabled = False
bersih
Txtkdbrg.SetFocus
End Sub
Private Sub Dgbarang_DblClick()
Tombol 0, 1, 1, 0, 1, 0, 0, 0
End Sub
Private Sub Dgbarang_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Txtkdbrg = Dgbarang.Columns(0).Value
Txtnmbrg = Dgbarang.Columns(1).Value
Txtstok = Dgbarang.Columns(2).Value
Cbsat = Dgbarang.Columns(3).Value
Txthrgbl = Dgbarang.Columns(4).Value
Txthrgjl = Dgbarang.Columns(5).Value
End Sub
Private Sub Form_Activate()
'--- settingan awal program
Txtkdbrg.MaxLength = 5
Txthrgbl.Alignment = 1
Txthrgjl.Alignment = 1
Txtstok.Alignment = 1
Isi = 0
Dgbarang.Enabled = True
bersih
Cbsat.Clear
Cbsat.AddItem "Sachet"
Cbsat.AddItem "Pack"
Cbsat.AddItem "Pcs"
Cbsat.AddItem "Bungkus"
Cbsat.AddItem "Botol"
Cbsat.AddItem "Dus"
Cbcari.Clear
Cbcari.AddItem "Kode Barang"
Cbcari.AddItem "Nama Barang"
Isian 0, 0, 0
Tombol 1, 0, 0, 0, 0, 1, 1, 1
'--- Tampil data barang
p = "select * from barang order by kdbrg"
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
Txtjmldata = dbarang.RecordCount
End Sub
Public Sub Isian(t1, t2, t3)
Txtkdbrg.Enabled = t1
Txtnmbrg.Enabled = t2
Cbsat.Enabled = t2
Txthrgbl.Enabled = t2
Txthrgjl.Enabled = t2
Txtstok.Enabled = t2
Cbcari.Enabled = t3
Txtcari.Enabled = t3
End Sub
Public Sub Tombol(p1, p2, p3, p4, p5, p6, p7, p8)
Cmdtambah.Enabled = p1
Cmdkoreksi.Enabled = p2
Cmdhapus.Enabled = p3
Cmdsimpan.Enabled = p4
Cmdbatal.Enabled = p5
Cmdcari.Enabled = p6
Cmdkeluar.Enabled = p7
Cmdrefresh.Enabled = p8
End Sub
Private Sub Form_Load()
Koneksi_mysql
End Sub
Public Sub Tampilan()
Dgbarang.Columns(0).Width = 1500
Dgbarang.Columns(0).Caption = "Kode Barang"
Dgbarang.Columns(1).Width = 3000
Dgbarang.Columns(1).Caption = "Nama Barang"
Dgbarang.Columns(2).Width = 1000
Dgbarang.Columns(2).Alignment = dbgRight
Dgbarang.Columns(2).Caption = "Stok"
Dgbarang.Columns(3).Width = 1500
Dgbarang.Columns(3).Caption = "Satuan"
Dgbarang.Columns(4).Width = 1500
Dgbarang.Columns(4).Alignment = dbgRight
Dgbarang.Columns(4).Caption = "Harga Beli"
Dgbarang.Columns(5).Width = 900
Dgbarang.Columns(5).Alignment = dbgRight
Dgbarang.Columns(5).Caption = "Harga Jual"
End Sub
Private Sub Form_Unload(Cancel As Integer)
sambung.Close
End Sub
Private Sub Txtcari_Change()
If Txtcari <> "" Then
Select Case Cbcari.ListIndex
Case 0
'--- pencarian menurut kode barang
p = "select * from barang where kdbrg like " + "'%" + Trim(Txtcari) + "%' order by nmbrg"
Case 1
'--- pencarian menurut nama barang
p = "select * from barang where nmbrg like " + "'%" + Trim(Txtcari) + "%' order by kdbrg"
End Select
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
End If
End Sub
Public Sub bersih()
Txtcari = ""
Txthrgbl = ""
Txthrgjl = ""
Txtkdbrg = ""
Txtnmbrg = ""
Txtstok = ""
Cbsat = ""
End Sub
5. Supplier
Public dbarang As New ADODB.Recordset
Public kembar As New ADODB.Recordset
Public Isi As Integer
Private Sub Cbcari_Click()
Txtcari = ""
Txtcari.SetFocus
End Sub
Private Sub Cmdbatal_Click()
Form_Activate
End Sub
Private Sub Cmdcari_Click()
Isian 0, 0, 1
Tombol 0, 0, 0, 0, 1, 1, 0, 1
bersih
Cbcari.SetFocus
End Sub
Private Sub Cmdhapus_Click()
p = "delete from supplier where kdsup='" & Txtkdbrg & "'"
If MsgBox("Yakin data ini akan dihapus?", vbQuestion + vbYesNo, "Hapus data") = vbYes Then
sambung.Execute (p)
End If
Form_Activate
End Sub
Private Sub Cmdkeluar_Click()
Unload Me
End Sub
Private Sub Cmdkoreksi_Click()
Isi = 2
Isian 0, 1, 0
Tombol 0, 0, 0, 1, 1, 0, 0, 0
Dgbarang.Enabled = False
Txtnmbrg.SetFocus
End Sub
Private Sub Cmdrefresh_Click()
p = "select * from supplier order by kdsup"
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
Txtjmldata = dbarang.RecordCount
Tampilan
Txtjmldata = dbarang.RecordCount
Cbcari = ""
Txtcari = ""
End Sub
Private Sub Cmdsimpan_Click()
If Isi = 1 Then
'--- validasi inputan kode barang
If Len(Txtkdbrg) < 7 Then
MsgBox "Inputan kode barang belum valid", vbInformation + vbOKOnly, "Ulangi"
Txtkdbrg = ""
Txtkdbrg.SetFocus
Else
'--- validasi data kembar (kode barang)
p = "select * from supplier where kdsup='" & Txtkdbrg & "'"
Set kembar = sambung.Execute(p)
If kembar.RecordCount <> 0 Then
MsgBox "Kode Barang Tersebut Sudah Ada", vbCritical + vbOKOnly, "Ulangi"
Txtkdbrg = ""
Txtkdbrg.SetFocus
Else
'--- Simpan data baru
p = "insert into supplier values('" & Txtkdbrg & "','" & Txtnmbrg & "','" & Txthrgbl & "','" & Txthrgjl
& "','" & Txtstok & "')"
sambung.Execute (p)
Form_Activate
End If
End If
End If
If Isi = 2 Then
'--- simpan data koreksi
p = "update supplier set nm_perush='" & Txtnmbrg & "'," & _
"almt='" & Txtstok & "'," & _
"kt='" & Txthrgbl & "'," & _
"telp='" & Txthrgjl & "'" & _
" where kdsup='" & Txtkdbrg & "'"
sambung.Execute (p)
Form_Activate
End If
End Sub
Private Sub Cmdtambah_Click()
Isi = 1
Isian 1, 1, 0
Tombol 0, 0, 0, 1, 1, 0, 0, 0
Dgbarang.Enabled = False
bersih
Txtkdbrg.SetFocus
End Sub
Private Sub Dgbarang_DblClick()
Tombol 0, 1, 1, 0, 1, 0, 0, 0
End Sub
Private Sub Dgbarang_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
Txtkdbrg = Dgbarang.Columns(0).Value
Txtnmbrg = Dgbarang.Columns(1).Value
Txthrgbl = Dgbarang.Columns(2).Value
Txthrgjl = Dgbarang.Columns(3).Value
Txtstok = Dgbarang.Columns(4).Value
End Sub
Private Sub Form_Activate()
'--- settingan awal program
Txtkdbrg.MaxLength = 7
Isi = 0
Dgbarang.Enabled = True
bersih
Cbcari.Clear
Cbcari.AddItem "Kode Supplier"
Cbcari.AddItem "Nama Perusahaan"
Isian 0, 0, 0
Tombol 1, 0, 0, 0, 0, 1, 1, 1
'--- Tampil data barang
p = "select * from supplier order by kdsup"
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
Txtjmldata = dbarang.RecordCount
End Sub
Public Sub Isian(t1, t2, t3)
Txtkdbrg.Enabled = t1
Txtnmbrg.Enabled = t2
Txthrgbl.Enabled = t2
Txthrgjl.Enabled = t2
Txtstok.Enabled = t2
Cbcari.Enabled = t3
Txtcari.Enabled = t3
End Sub
Public Sub Tombol(p1, p2, p3, p4, p5, p6, p7, p8)
Cmdtambah.Enabled = p1
Cmdkoreksi.Enabled = p2
Cmdhapus.Enabled = p3
Cmdsimpan.Enabled = p4
Cmdbatal.Enabled = p5
Cmdcari.Enabled = p6
Cmdkeluar.Enabled = p7
Cmdrefresh.Enabled = p8
End Sub
Private Sub Form_Load()
Koneksi_mysql
End Sub
Public Sub Tampilan()
Dgbarang.Columns(0).Width = 1700
Dgbarang.Columns(0).Caption = "Kode Supplier"
Dgbarang.Columns(1).Width = 3800
Dgbarang.Columns(1).Caption = "Nama Perusahaan"
Dgbarang.Columns(2).Width = 800
Dgbarang.Columns(2).Caption = "Alamat"
Dgbarang.Columns(3).Width = 1300
Dgbarang.Columns(3).Caption = "Kota"
Dgbarang.Columns(4).Width = 1000
Dgbarang.Columns(4).Caption = "Telepon"
End Sub
Private Sub Form_Unload(Cancel As Integer)
sambung.Close
End Sub
Private Sub Txtcari_Change()
If Txtcari <> "" Then
Select Case Cbcari.ListIndex
Case 0
'--- pencarian menurut kode supplier
p = "select * from supplier where kdsup like " + "'%" + Trim(Txtcari) + "%' order by nm_perush"
Case 1
'--- pencarian menurut nama perusahaan
p = "select * from supplier where nm_perush like " + "'%" + Trim(Txtcari) + "%' order by kdsup"
End Select
Set dbarang = sambung.Execute(p)
Set Dgbarang.DataSource = dbarang
Tampilan
End If
End Sub
Public Sub bersih()
Txtcari = ""
Txthrgbl = ""
Txthrgjl = ""
Txtkdbrg = ""
Txtnmbrg = ""
Txtstok = ""
End Sub
