Pengkodean VB

AWAL
Private Sub Timer1_Timer()
i = i + 2
If i.Value = "10" Then
Label2.Caption = "10%"
ElseIf i.Value = "20" Then
Label2.Caption = "20%"
ElseIf i.Value = "30" Then
Label2.Caption = "30%"
ElseIf i.Value = "40" Then
Label2.Caption = "40%"
ElseIf i.Value = "50" Then
Label2.Caption = "50%"
ElseIf i.Value = "60" Then
Label2.Caption = "60%"
ElseIf i.Value = "70" Then
Label2.Caption = "70%"
ElseIf i.Value = "80" Then
Label2.Caption = "80%"
ElseIf i.Value = "90" Then
Label2.Caption = "90%"
ElseIf i.Value = "98" Then
Label2.Caption = "100%"
End If
If i = 98 Then
frmlogin.Show
Unload Me
End If
End Sub


Private Sub Timer2_Timer()
Label1.Visible = Not Label1.Visible
End Sub

LOGIN
Private Sub Command1_Click()
If txtuser = "" Or txtpwd = "" Then MsgBox "data kurang lengkap", vbCritical, "Data Salah": Exit Sub
bukaDB
    rec.Open "SELECT * FROM tbl_login WHERE [UID]= '" & txtuser.Text & "'", conn, adOpenStatic, adLockOptimistic
If rec.EOF Then
    MsgBox "Data Tidak Terdaftar"
Else
    If txtpwd.Text = rec("PWD") And rec("hak_acces") = "admin" Then
    hakakses = "admin"
        frmmenu.Show

        Unload Me
    ElseIf txtpwd.Text = rec("PWD") And rec("hak_acces") = "user" Then
    hakakses = "user"
    frmmenu.Show
    frmmenu.admin.Enabled = False
    frmmenu.signin.Enabled = False
    frmmenu.settinguser.Enabled = False
    frmmenu.print2.Enabled = False
   Unload Me
    Else
       MsgBox "Maaf Password yang anda masukan salah"
    End If
End If
tutupDB
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
txtuser = ""
txtpwd = ""
End Sub

Private Sub Timer1_Timer()
Label3.Visible = Not Label3.Visible
End Sub

Private Sub txtpwd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
End If
End Sub





MENU
Private Sub anggota_Click()
LaporanMasuk.PrintReport
End Sub

Private Sub anggota1_Click()
frmanggota.Show
frmmenu.Hide
Unload Me

End Sub

Private Sub Form_Activate()
If hakakses = "admin" Then
        frmmenu.signin.Enabled = False
        frmmenu.user.Enabled = False
ElseIf hakakses = "user" Then
    frmmenu.admin.Enabled = False
    frmmenu.signin.Enabled = False
    frmmenu.settinguser.Enabled = False
    frmmenu.print2.Enabled = False
End If
End Sub

Private Sub kalkulator_Click()
frmkalkulator.Show
Unload Me
End Sub
Private Sub keluar_Click()
If MsgBox("Terimakasih telah menggunakan Aplikasi kami") Then
End If
End
End Sub

Private Sub out_Click()
laporankeluar.PrintReport
End Sub

Private Sub outputbarang_Click()
frmoutput.Show
Unload Me
End Sub


Private Sub listanggota_Click()
frmlist.Show
frmlist.Command4.Visible = False
frmlist.l.FullRowSelect = False
Unload Me
End Sub

Private Sub listuangkeluar_Click()
listout.Show
listout.Command4.Visible = False
listout.l.FullRowSelect = False
Unload Me
End Sub

Private Sub listuangmasuk_Click()
frmlistmasuk.Show
frmmenu.Hide
Unload Me
End Sub

Private Sub sejarah_Click()
frmsejarah.Show
Unload Me
End Sub

Private Sub settinguser_Click()
frmuser.Show
Unload Me
End Sub

Private Sub signin_Click()
frmlogin.Show
Unload Me
End Sub

Private Sub signout_Click()
frmmenu.signout.Enabled = False
frmmenu.Show
Unload Me
End Sub

Private Sub Tentangkami_Click()
frmtntgkami.Show
Unload Me
End Sub

Private Sub Timer1_Timer()
Label4.Caption = Date
Label2.Caption = Time
End Sub

Private Sub Timer2_Timer()
Dim Kalimat As String
    Kalimat = "Koperasi Simpati"
    counter = counter + 1
    DoEvents
    Label3.Caption = TulisJalan(counter, Kalimat, 30)
End Sub
Public Function TulisJalan(hitung As Integer, strKalimat As String, _
                           Panjang As Integer)
  If hitung = Len(strKalimat) + Panjang Then
     hitung = 0
  ElseIf hitung > Len(strKalimat) Then
     TulisJalan = strKalimat & Space(hitung - Len(strKalimat))
  Else
     TulisJalan = Mid(strKalimat, 1, hitung)
  End If
End Function

Private Sub uangkeluar_Click()
laporankeluar.PrintReport
End Sub

Private Sub uangkeluar2_Click()
frmkeluar.Show
frmmenu.Hide
Unload Me
End Sub

Private Sub um_Click()
frmmasuk.Show
frmmenu.Hide
Unload Me
End Sub

Private Sub visimisi_Click()
frmvimi.Show
Unload Me
End Sub

ANGGOTA
Private Sub Command1_Click()
Text1.Text = ""
Text2.Text = ""
text4.Text = ""
Text5.Text = ""
Text3.Text = ""
Text8.Text = ""
Text7.Text = ""
frmanggota.Command5.Enabled = True
Command4.Enabled = False
Text8.Enabled = True
End Sub

Private Sub Command2_Click()
frmmenu.Show
frmanggota.Hide
Unload Me
End Sub

Private Sub Command3_Click()
Dim hapusdata As String
hapusdata = "DELETE FROM tbl_anggota WHERE no LIKE '" & Text8.Text & "'"
bukaDB
conn.Execute hapusdata
MsgBox "data sudah di hapus"
tutupDB
End Sub

Private Sub Command4_Click()
bukaDB
conn.Execute "UPDATE tbl_anggota SET nama_lengkap='" & Text1.Text & "',tanggal_bergabung='" & DTPicker1.Value & "',alamat='" & Text2.Text & "',rt_rw='" & Text5.Text & "',kec_kel='" & Text7.Text & "',kab_kota='" & text4.Text & "',no_telp='" & Text3.Text & "' WHERE no LIKE '" & Text8.Text & "'"
MsgBox "Data berhasil di edit"
tutupDB
End Sub

Private Sub Command5_Click()
On Error GoTo kode_salah
If Text1.Text = "" Or Text2.Text = "" Or text4.Text = "" Or Text5.Text = "" Or Text7.Text = "" Or Text3.Text = "" Then MsgBox "Data Kurang Lengkap": Exit Sub
bukaDB
conn.Execute "INSERT INTO  tbl_anggota (no,nama_lengkap,tanggal_bergabung,alamat,rt_rw,kec_kel,kab_kota,no_telp) VALUES ('" & Text8.Text & "','" & Text1.Text & "','" & Text2.Text & "','" & DTPicker1.Value & "','" & text4.Text & "','" & Text5.Text & "','" & Text7.Text & "','" & Text3.Text & "')"
frmlist.Show
MsgBox "Data Berhasil Di Simpan ", vbInformation, "SUKSESS"
kosong
kode_salah:
If Err.Number = -2147217913 Then
MsgBox "Pada no, rt_rw , no_telp di harapkan memakai angka bukan huruf"
End If
tutupDB
End Sub

Sub kosong()
Text1.Text = ""
Text2.Text = ""
text4.Text = ""
Text5.Text = ""
Text7.Text = ""
Text3.Text = ""
Text8.Text = ""
End Sub

Private Sub Command6_Click()
frmlist.Show
Unload Me
End Sub

Private Sub Command7_Click()

End Sub



Private Sub text4_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub


Private Sub Text5_Change()
KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)
End Sub


Private Sub Text6_Change()
KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)
End Sub

Private Sub Text7_Change()
KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)
End Sub

Private Sub Text8_Change()
KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)
End Sub

LIST ANGGOTA
Private Sub Command1_Click()
Unload Me
frmanggota.Show
frmlist.Hide
End Sub

Private Sub Command4_Click()
frmanggota.Text8.Enabled = False
frmanggota.Show
frmanggota.Command4.Enabled = True
frmanggota.Command5.Enabled = False
frmanggota.Text8.Text = l.SelectedItem.ListSubItems(1)
frmanggota.Text1.Text = l.SelectedItem.ListSubItems(2)
frmanggota.Text2.Text = l.SelectedItem.ListSubItems(3)
frmanggota.Text5.Text = l.SelectedItem.ListSubItems(4)
frmanggota.Text7.Text = l.SelectedItem.ListSubItems(5)
frmanggota.text4.Text = l.SelectedItem.ListSubItems(6)
frmanggota.Text3.Text = l.SelectedItem.ListSubItems(7)
Unload Me
End Sub

Private Sub Form_Load()

tampildatalist
End Sub
Sub tampildatalist()
bukaDB
rec.Open "SELECT * FROM tbl_anggota", conn, adOpenStatic, adLockOptimistic
l.ListItems.Clear
i = 1
Do While Not rec.EOF

l.ListItems.Add (i), , (i)
l.ListItems(i).ListSubItems.Add 1, , rec("no")
l.ListItems(i).ListSubItems.Add 2, , rec("nama_lengkap")
l.ListItems(i).ListSubItems.Add 3, , rec("tanggal_bergabung")
l.ListItems(i).ListSubItems.Add 4, , rec("alamat")
l.ListItems(i).ListSubItems.Add 5, , rec("rt_rw")
l.ListItems(i).ListSubItems.Add 6, , rec("kec_kel")
l.ListItems(i).ListSubItems.Add 7, , rec("kab_kota")
l.ListItems(i).ListSubItems.Add 8, , rec("no_telp")

i = i + 1
rec.MoveNext
Loop
tutupDB
End Sub


Private Sub l_DblClick()
frmanggota.Command5.Enabled = False
frmanggota.Text8.Enabled = False
frmanggota.Show
frmanggota.Command4.Enabled = True
frmanggota.Command5.Enabled = False
frmanggota.Text8.Text = l.SelectedItem.ListSubItems(1)
frmanggota.Text1.Text = l.SelectedItem.ListSubItems(2)
frmanggota.Text2.Text = l.SelectedItem.ListSubItems(3)
frmanggota.Text5.Text = l.SelectedItem.ListSubItems(4)
frmanggota.Text7.Text = l.SelectedItem.ListSubItems(5)
frmanggota.text4.Text = l.SelectedItem.ListSubItems(6)
frmanggota.Text3.Text = l.SelectedItem.ListSubItems(7)
Unload Me
End Sub

UANG MASUK
Private Sub Command1_Click()
Text1 = ""
Text2 = ""
Text7 = ""
Text3 = ""
Text6 = ""
Text5 = ""
Text8 = ""
End Sub

Private Sub Command2_Click()
frmmenu.Show
frmkeluar.Hide
Unload Me
End Sub

Private Sub Command3_Click()
bukaDB
conn.Execute "DELETE FROM   tbl_masuk WHERE no_anggota LIKE '" & Text1.Text & "'"
MsgBox "Data berhasil di hapus"
kosong
tutupDB
End Sub

Private Sub Command4_Click()
bukaDB
conn.Execute "update tbl_masuk set  nama_lengkap='" & Text2.Text & "',simpanan_wajib='" & Text7.Text & "',tanggal='" & DTPicker1.Value & "',simpanan_sukarela='" & Text3.Text & "' where no_anggota LIKE '" & Text1.Text & "'"
MsgBox "Data berhasil di ubah"
frmlistmasuk.Show
Unload Me
tutupDB
End Sub

Private Sub Command5_Click()
'On Error GoTo kode_salah
If Text1.Text = "" Or Text2.Text = "" Or Text7.Text = "" Or Text3.Text = "" Then MsgBox "Data Kurang Lengkap": Exit Sub
bukaDB
conn.Execute "INSERT INTO  tbl_masuk (no_anggota,nama_lengkap,simpanan_wajib,simpanan_sukarela,tanggal) VALUES ('" & Text1.Text & "','" & Text2.Text & "','" & Text7.Text & "','" & Text3.Text & "','" & DTPicker1.Value & "')"
frmlistmasuk.Show
MsgBox "Data Berhasil Di Simpan ", vbInformation, "SUKSESS"

kode_salah:
If Err.Number = -2147217913 Then
MsgBox "Pada no_anggota, simpanan_wajib, simpanan_sukarela , di harapkan memakai angka bukan huruf"
End If
tutupDB
End Sub

Private Sub Command6_Click()
frmlistmasuk.Show
Unload Me
End Sub

LIST  UANG MASUK
Private Sub Command1_Click()
frmmasuk.Show
frmlistmasuk.Hide
Unload Me
End Sub

Private Sub Command4_Click()
frmmasuk.Text8.Enabled = False
frmmasuk.Show
frmmasuk.Command4.Enabled = True
frmmasuk.Command5.Enabled = False

frmmasuk.Text1.Text = l.SelectedItem.ListSubItems(1)
frmmasuk.Text2.Text = l.SelectedItem.ListSubItems(2)
frmmasuk.Text3.Text = l.SelectedItem.ListSubItems(3)
frmmasuk.Text7.Text = l.SelectedItem.ListSubItems(4)
Unload Me
End Sub

Private Sub Form_Load()

tampildatalist
End Sub
Sub tampildatalist()
bukaDB
rec.Open "SELECT * FROM tbl_masuk", conn, adOpenStatic, adLockOptimistic
l.ListItems.Clear
i = 1
Do While Not rec.EOF

l.ListItems.Add (i), , (i)
l.ListItems(i).ListSubItems.Add 1, , rec("no_anggota")
l.ListItems(i).ListSubItems.Add 2, , rec("nama_lengkap")
l.ListItems(i).ListSubItems.Add 3, , rec("simpanan_wajib")
l.ListItems(i).ListSubItems.Add 4, , rec("simpanan_sukarela")
l.ListItems(i).ListSubItems.Add 5, , rec("tanggal")

i = i + 1
rec.MoveNext
Loop
tutupDB
End Sub


Private Sub l_DblClick()
frmmasuk.Command5.Enabled = False
frmmasuk.Text8.Enabled = False
frmmasuk.Show
frmmasuk.Command4.Enabled = True
frmmasuk.Command5.Enabled = False

frmmasuk.Text1.Text = l.SelectedItem.ListSubItems(1)
frmmasuk.Text2.Text = l.SelectedItem.ListSubItems(2)
frmmasuk.Text7.Text = l.SelectedItem.ListSubItems(3)
frmmasuk.Text3.Text = l.SelectedItem.ListSubItems(4)
frmmasuk.DTPicker1.Value = l.SelectedItem.ListSubItems(5)


Unload Me
End Sub


End Sub

UANG KELUAR
Private Sub Command1_Click()
Text1 = ""
Text2 = ""
text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Text8 = ""
End Sub

Private Sub Command2_Click()
frmmenu.Show
frmkeluar.Hide
Unload Me
End Sub

Private Sub Command3_Click()
bukaDB
conn.Execute "DELETE FROM   tbl_keluar WHERE no_anggota LIKE '" & Text1.Text & "'"
MsgBox "Data berhasil di hapus"
kosong
tutupDB
End Sub

Private Sub Command4_Click()
bukaDB
conn.Execute "update tbl_keluar set  nama_lengkap='" & Text2.Text & "',jangka_pinjaman='" & text4.Text & "',tanggal='" & DTPicker1.Value & "',jumlah_pinjaman='" & Text3.Text & "' where no_anggota LIKE '" & Text1.Text & "'"
MsgBox "Data berhasil di ubah"
listout.Show
Unload Me
tutupDB
End Sub

Private Sub Command5_Click()
'On Error GoTo kode_salah
If Text1.Text = "" Or Text2.Text = "" Or text4.Text = "" Or Text3.Text = "" Then MsgBox "Data Kurang Lengkap": Exit Sub
bukaDB
conn.Execute "INSERT INTO  tbl_keluar (no_anggota,nama_lengkap,jangka_pinjaman,jumlah_pinjaman,tanggal) VALUES ('" & Text1.Text & "','" & Text2.Text & "','" & text4.Text & "','" & Text3.Text & "','" & DTPicker1.Value & "')"
listout.Show
MsgBox "Data Berhasil Di Simpan ", vbInformation, "SUKSESS"
kosong
kode_salah:
If Err.Number = -2147217913 Then
MsgBox "Pada no_anggota , di harapkan memakai angka bukan huruf"
End If
tutupDB
End Sub

Sub kosong()
Text1 = ""
Text2 = ""
text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Text8 = ""
End Sub

Private Sub Command6_Click()
listout.Show
Unload Me
End Sub


Private Sub Text5_Change()
KeyAscii = 0
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
KeyAscii = IIf((KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 8, KeyAscii, 0)
End Sub

Private Sub Text7_Change()
KeyAscii = 0
End Sub

LIST UANG KELUAR
Sub tampildatalist1()
bukaDB
rec.Open "SELECT * FROM tbl_keluar", conn, adOpenStatic, adLockOptimistic
l.ListItems.Clear
i = 1
Do While Not rec.EOF

l.ListItems.Add i, , i
l.ListItems(i).ListSubItems.Add 1, , rec("no_anggota")
l.ListItems(i).ListSubItems.Add 2, , rec("nama_lengkap")
l.ListItems(i).ListSubItems.Add 3, , rec("jangka_pinjaman")
l.ListItems(i).ListSubItems.Add 4, , rec("jumlah_pinjaman")
l.ListItems(i).ListSubItems.Add 5, , rec("tanggal")

i = i + 1
rec.MoveNext
Loop
tutupDB
End Sub


Private Sub Command1_Click()
Unload Me
frmkeluar.Show
End Sub

Private Sub Command4_Click()
frmkeluar.Show
frmkeluar.Command4.Enabled = True
frmkeluar.Command3.Enabled = True
frmkeluar.Command5.Enabled = False
frmkeluar.Text1.Text = l.SelectedItem.ListSubItems(1)
frmkeluar.Text2.Text = l.SelectedItem.ListSubItems(2)

frmkeluar.text4.Text = l.SelectedItem.ListSubItems(3)

Unload Me
End Sub

Private Sub Form_Load()
tampildatalist1
End Sub



Private Sub listdataout_DblClick()
frmkeluar.Show
frmkeluar.Command4.Enabled = True
frmkeluar.Command3.Enabled = True
frmkeluar.Command5.Enabled = False
frmkeluar.Text8.Text = l.SelectedItem.ListSubItems(8)
frmkeluar.Text1.Text = l.SelectedItem.ListSubItems(1)
frmkeluar.Text2.Text = l.SelectedItem.ListSubItems(2)
frmkeluar.DTPicker1.Value = l.SelectedItem.ListSubItems(4)
frmkeluar.text4.Text = l.SelectedItem.ListSubItems(3)
frmkeluar.Text3.Text = l.SelectedItem.ListSubItems(7)
Unload Me
End Sub

USER
Sub tampillistuser()
Listuser.ListItems.Clear
bukaDB
rec.Open "SELECT * FROM tbl_login", conn, adOpenStatic, adLockOptimistic
i = 1
Do While Not rec.EOF
Listuser.ListItems.Add i, , i
Listuser.ListItems(i).ListSubItems.Add 1, , rec("UID")
Listuser.ListItems(i).ListSubItems.Add 2, , rec("PWD")
Listuser.ListItems(i).ListSubItems.Add 3, , rec("Nama_User")
Listuser.ListItems(i).ListSubItems.Add 4, , rec("Hak_Acces")
rec.MoveNext
i = i + 1
Loop
tutupDB
End Sub

Private Sub Command1_Click()
Text1.Locked = False
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Option2.Value = False
Option1.Value = False
End Sub

Private Sub Command2_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Option2.Value = False And Option1.Value = False Then MsgBox "Data belum lengkap": Exit Sub
bukaDB
conn.Execute "DELETE FROM tbl_login WHERE UID LIKE '" & Text1.Text & "'"
MsgBox "data dihapus"
tampillistuser
Command4_Click
tutupDB
End Sub

Private Sub Command3_Click()
Dim hak As String
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Option2.Value = False And Option1.Value = False Then MsgBox "Data belum lengkap": Exit Sub
If Option1.Value = True Then
hak = "admin"
ElseIf Option2.Value = True Then hak = "user"
End If
bukaDB
conn.Execute "UPDATE tbl_login SET PWD='" & Text2.Text & "',Nama_User='" & Text3.Text & "',Hak_Acces='" & hak & "' WHERE UID LIKE '" & Text1.Text & "'"
MsgBox "User anda berhasil di update"
Command4_Click
Form_Load
tutupDB
End Sub

Private Sub Command4_Click()
Text1.Locked = False
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Option2.Value = False
Option1.Value = False
End Sub

Private Sub Command5_Click()
If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Option2.Value = False And Option1.Value = False Then MsgBox "Data belum lengkap": Exit Sub
If Option1.Value = True Then
hak = "admin"
ElseIf Option2.Value = True Then
hak = "user"
End If

bukaDB
conn.Execute "INSERT INTO tbl_login (UID,PWD,Nama_User,Hak_Acces) VALUES('" & Text1.Text & "','" & Text2.Text & "','" & Text3.Text & "','" & hak & "')"
MsgBox "data disimpan"
tampillistuser
Command4_Click
tutupDB
End Sub

Private Sub Command6_Click()
frmmenu.Show
Unload Me
End Sub

Private Sub Form_Load()
tampillistuser
End Sub

Private Sub Form_Unload(Cancel As Integer)
frmmenu.Show
Unload Me
End Sub

Private Sub Listuser_DblClick()
Text1.Locked = True
Text1.Text = Listuser.SelectedItem.SubItems(1)
Text2.Text = Listuser.SelectedItem.SubItems(2)
Text3.Text = Listuser.SelectedItem.SubItems(3)
If Listuser.SelectedItem.SubItems(4) = "user" Then
Option2.Value = True
Option1.Value = False
ElseIf Listuser.SelectedItem.SubItems(4) = "admin" Then
Option1.Value = True
Option2.Value = False
End If
End Sub

Private Sub Option1_Click()
Option1.Value = True
Option2.Value = False
End Sub

Private Sub Option2_Click()
Option1.Value = False
Option2.Value = True
End Sub





LLL
Diposting oleh Ekha mardiana di 04.56 0 komentar

Tutorial Database Visual Basic













Diposting oleh Ekha mardiana di 04.46 0 komentar
Langganan: Postingan (Atom)