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
