LAMPIRAN A : LISTING PROGRAM

LAMPIRAN A : LISTING PROGRAM

Source Code module Public Public Public Public Public

Conn As New ADODB.Connection RSKasir As ADODB.Recordset RSAnggota As ADODB.Recordset RSSimpan As ADODB.Recordset RSPinjam As ADODB.Recordset

Public Sub BukaDB() Set Conn = New ADODB.Connection Set RSKasir = New ADODB.Recordset Set RSAnggota = New ADODB.Recordset Set RSSimpan = New ADODB.Recordset Set RSPinjam = New ADODB.Recordset Conn.Open"PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Program koperasi safwan\Program Koperasi\DBKOPERASI.mdb"

Source Code Form Login Dim A As Byte Dim B As Byte Private Sub Form_Load() TxtNamaKsr.MaxLength = 35 TxtPasswordKsr.MaxLength = 15 TxtPasswordKsr.PasswordChar = "*" TxtPasswordKsr.Enabled = False TxtKodeKsr.Enabled = False End Sub Private Sub TxtNamaKsr_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 27 Then Unload Me If Keyascii = 13 Then Call BukaDB RSKasir.Open "Select NamaKsr from TBLKasir where NamaKsr ='" & TxtNamaKsr & "'", Conn

Universitas Sumatera Utara

If RSKasir.EOF Then A = A + 1 If 1 - A = 0 Then MsgBox"Kesempatan ke"&A& " Salah"&Chr(13)&_ "Nama'"&TxtNamaKsr& "'tidak dikenal" TxtNamaKsr = "" TxtNamaKsr.SetFocus ElseIf 2 – A = 0 Then MsgBox "Kesempatan ke "&A&"Salah"&Chr(13)&_ "Nama'"&TxtNamaKsr&"'tidak dikenal" TxtNamaKsr = "" TxtNamaKsr.SetFocus ElseIf 3 – A = 0 Then MsgBox"Kesempatan ke"&A&"Salah"&Chr(13)&_ "Nama'"&TxtNamaKsr&"'tidak dikenal"& Chr(13)& _ "Kesempatan habis,Ulangi dari awal" 'End Unload Me Exit Sub End If Else TxtNamaKsr.Enabled = False TxtPasswordKsr.Enabled = True TxtPasswordKsr.SetFocus End If End If End Sub

Private Sub txtpasswordksr_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 27 Then Unload Me Dim LoginKasir As String Dim KodeKasir As String Dim NamaKasir As String If Keyascii = 13 Then

Call BukaDB RSKasir.Open "Select*from TBLKasir where NamaKsr='"& TxtNamaKsr&"'and PasswordKsr='"&TxtPasswordKsr&"'",Conn If RSKasir.EOF Then B = B + 1 If 1 - B = 0 Then MsgBox "Kesempatan ke"&B&"Salah"


TxtPasswordKsr = "" TxtPasswordKsr.SetFocus ElseIf 2-B = 0 Then MsgBox "Kesempatan ke"&B&"Salah" TxtPasswordKsr = "" TxtPasswordKsr.SetFocus ElseIf 3 - B = 0 Then MsgBox "Kesempatan ke"&B&"Salah" 'End Unload Me Exit Sub End If Else 'Unload Me Login.Visible = False MENU.Show KodeKasir = RSKasir!Kodeksr NamaKasir = RSKasir!Namaksr Kodeksr = KodeKasir Namaksr = NamaKasir MENU.StatusBar1.Panels(1) = KodeKasir MENU.StatusBar1.Panels(2) = NamaKasir End If End If End Sub

Source Code Form Utama Private Sub Form_KeyPress(Keyascii As Integer) If Keyascii = 27 Then End End Sub Private Sub MNANGGOTA_Click() ANGGOTA.Show vbModal End Sub Private Sub MNKELUAR_Click() End End Sub Private Sub MNLAPPINJAM_Click() LAPPINJAM.Show vbModal End Sub


Private Sub MNLAPSIMPAN_Click() LAPSIMPAN.Show vbModal End Sub Private Sub MNPINJAM_Click() PINJAMAN.Show vbModal End Sub Private Sub mnsimpan_Click() SIMPANAN.Show End Sub Private Sub MNSQL_Click() UjiSQL.Show vbModal End Sub

Source Code Form Anggota 'LblLokasi.Caption=(App.Path& "\FOTO\" & Trim(Text1.Text) &".JPEG") Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0 ;Data Source=D:\Program koperasi safwan\Program Koperasi\DBKOPERASI.mdb" Adodc1.RecordSource = "TBLAnggota" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Adodc1.Visible = False End Sub

Sub Form_Load() Nama.MaxLength = 30 SmpWajib.MaxLength = 8 SmpPokok.MaxLength = 8 Saldo.MaxLength = 8 KondisiAwal End Sub


Function CariData() Call BukaDB RSAnggota.Open"Select*From TBLAnggota where No_Anggota='"&NoAnggota&"'",Conn End Function

Private Sub KosongkanText() NoAnggota ="" Nama ="" SmpWajib ="" SmpPokok ="" Saldo ="" FolderFoto ="" End Sub Private Sub SiapIsi() 'enabled = true menyebabkan objek dpt dimasuki kursor NoAnggota.Enabled = True Nama.Enabled = True SmpWajib.Enabled = True SmpPokok.Enabled = True Saldo.Enabled = True End Sub

Private Sub TidakSiapIsi() 'enabled = false menyebabkan objek tdk dpt dimasuki kursor NoAnggota.Enabled = False Nama.Enabled = False SmpWajib.Enabled = False SmpPokok.Enabled = False Saldo.Enabled = False FolderFoto.Enabled = False End Sub

Private Sub KondisiAwal() Form_Activate KosongkanText TidakSiapIsi Command1.Caption = "&Input" Command2.Caption = "&Edit" Command3.Caption = "&Hapus" Command4.Caption = "&Tutup" Command1.Enabled = True Command2.Enabled = True


Command3.Enabled = True End Sub

Private Sub TampilkanData() With RSAnggota Nama = RSAnggota!Nama SmpWajib = RSAnggota!wajib SmpPokok = RSAnggota!Pokok Saldo = RSAnggota!Saldo FolderFoto = RSAnggota!lokasi 'Picture1.Picture = LoadPicture(RSAnggota!foto) End With End Sub

Private Sub Command1_Click() If Command1.Caption = "&Input" Then Command1.Caption = "&Simpan" Command2.Enabled = False Command3.Enabled = False Command4.Caption = "&Batal" NoAnggota.Clear SiapIsi KosongkanText NoAnggota.SetFocus Else If NoAnggota = "" Or Nama = "" Or SmpWajib = "" Or SmpPokok =""Or Saldo="" Then MsgBox "Data Belum Lengkap...!" ElseIf FolderFoto = "" Then MsgBox "Belum ada foto" Picture1_Click Exit Sub Else 'FolderFoto=(App.Path&"\FOTO\"&Trim(Text1.Text)& ".JPEG") Dim SQLTambah As String SQLTambah="Insert Into TBLAnggota (No_Anggota,Nama,wajib,Pokok,Saldo,lokasi,foto)values"&_ "('"&NoAnggota&"','"& Nama&"','"&SmpWajib& "','"&SmpPokok&"','" &Saldo &"','"&FolderFoto&"','"& Picture1&"')" Conn.Execute SQLTambah


Form_Activate Call KondisiAwal End If End If End Sub

Private Sub command2_Click() If Command2.Caption = "&Edit" Then Command1.Enabled = False Command2.Caption = "&Simpan" Command3.Enabled = False Command4.Caption = "&Batal" SiapIsi NoAnggota.SetFocus Call BukaDB RSAnggota.Open "TBLAnggota", Conn NoAnggota.Clear Do Until RSAnggota.EOF NoAnggota.AddItem RSAnggota!no_anggota RSAnggota.MoveNext Loop Else If NoAnggota =""OrNama=""OrSmpWajib=""Or SmpPokok =""Or Saldo=""Or FolderFoto="" Then MsgBox "Masih Ada Data Yang Kosong" Else Dim SQLEdit As String SQLEdit="Update TBLAnggota Set Nama='"&Nama& "',wajib='"&SmpWajib&"',Pokok='" &SmpPokok&"',Saldo='"& Saldo&"',lokasi='"&FolderFoto&"',foto='"&Picture1.Picture & "'where No_Anggota='"&NoAnggota&"'" Conn.Execute SQLEdit Form_Activate Call KondisiAwal End If End If End Sub

Private Sub command3_Click() If Command3.Caption = "&Hapus" Then Command1.Enabled = False Command2.Enabled = False Command4.Caption = "&Batal" KosongkanText


SiapIsi NoAnggota.SetFocus Call BukaDB RSAnggota.Open "TBLAnggota", Conn NoAnggota.Clear Do Until RSAnggota.EOF NoAnggota.AddItem RSAnggota!no_anggota RSAnggota.MoveNext Loop End If End Sub

Private Sub command4_Click() Select Case Command4.Caption Case "&Tutup" Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub

Private Sub NoAnggota_Click() Call CariData Call TampilkanData End Sub

Private Sub NoAnggota_Keypress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then If Len(NoAnggota) < 3 Or Len(NoAnggota) > 3 Then MsgBox "Kode Harus 3 Digit, Contoh 'A01'" NoAnggota.SetFocus Exit Sub Else Nama.SetFocus End If If Command1.Caption = "&Simpan" Then Call CariData If Not RSAnggota.EOF Then TampilkanData


MsgBox "Kode Anggota Sudah Ada" KosongkanText NoAnggota.SetFocus Else Nama.SetFocus End If End If If Command2.Caption = "&Simpan" Then Call CariData If Not RSAnggota.EOF Then TampilkanData NoAnggota.Enabled = False Nama.SetFocus Else MsgBox "Kode Anggota Tidak Ada" NoAnggota = "" NoAnggota.SetFocus End If End If If Command3.Enabled = True Then Call CariData If Not RSAnggota.EOF Then TampilkanData Pesan = MsgBox("Yakin akan dihapus", vbYesNo) If Pesan = vbYes Then Dim SQLHapus As String SQLHapus="Delete From TBLAnggota where No_Anggota='"&NoAnggota&"'" Conn.Execute SQLHapus Form_Activate Call KondisiAwal Else Form_Activate Call KondisiAwal Command3.SetFocus End If Else MsgBox "Data Tidak ditemukan" NoAnggota.SetFocus End If End If End If End Sub


Private Sub Picture1_Click() Cdlg1.ShowOpen FolderFoto = Cdlg1.FileName End Sub

Private Sub Nama_KeyPress(Keyascii As Integer) Keyascii = Asc(UCase(Chr(Keyascii))) If Keyascii = 13 Then SmpWajib.SetFocus End Sub

Private Sub smpwajib_KeyPress(Keyascii As Integer) If Keyascii = 13 Then SmpPokok.SetFocus If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0 End Sub

Private Sub smpPokok_KeyPress(Keyascii As Integer) If Keyascii = 13 Then Saldo = Val(SmpWajib) + Val(SmpPokok) Saldo.Enabled = False If Command1.Enabled = True Then Command1.SetFocus ElseIf Command2.Enabled = True Then Command2.SetFocus End If End If If Not (Keyascii >= Asc("0") And Keyascii <= Asc("9") Or Keyascii = vbKeyBack) Then Keyascii = 0 End Sub

Private Sub FolderFoto_Change() Picture1.Picture = LoadPicture(FolderFoto) End Sub

Source Code Form Simpanan Private Sub Form_Activate() Call BukaDB


Adodc1.ConnectionString="Provider=Microsoft.Jet.OLEDB.4.0 ;Data Source=D:\Program koperasi safwan\Program Koperasi\DBKOPERASI.mdb" Adodc1.RecordSource = "TBLSimpan" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Call NoSimpan Tanggal=Format(Date,"DD-MMM-YYYY") End Sub

'prosedur untuk membuat nomor pinjam otomatis dengan pola SPNYYMMDD999 Private Sub NoSimpan() Call BukaDB RSSimpan.Open "select * from TBLSIMPAN Where NO_SIMPAN In(Select Max(NO_SIMPAN)From TBLSIMPAN)Order By NO_SIMPAN Desc", Conn RSSimpan.Requery Dim Urutan As String * 12 Dim Hitung As Long With RSSimpan If.EOF Then Urutan="SPN"+Format(Date,"yymmdd")+"001" Nomor = Urutan Else If Mid(!No_Simpan, 4, 6) < > Format(Date, "yymmdd") Then Uruta="SPN"+Format(Date,"yymmdd")+"001" Else Hitung = Right(!No_Simpan,9)+1 Urutan = "SPN" + Format(Date, "yymmdd")+ Right("000"&Hitung,3) End If End If Nomor = Urutan End With End Sub

'pada saat form dipanggil,tampilkan nomor anggota di dalam combo Private Sub Form_Load() Call BukaDB RSAnggota.Open "select * from tblanggota", Conn CBOAgt.Clear


Do While Not RSAnggota.EOF CBOAgt.AddItem RSAnggota!no_anggota RSAnggota.MoveNext Loop CBOAgt.Enabled = False JmlSimpan.Enabled = False End Sub

Sub KondisiAwal() CBOAgt = "" Nama = "" Saldo = "" JmlSimpan = "" Picture1.Picture = LoadPicture() CBOAgt.Enabled = False JmlSimpan.Enabled = False CmdInput.Caption = "&Input" CmdTutup.Caption = "&Tutup" End Sub 'pada saat nomor anggota dipilih dalam combo, tampilkan nama anggota, saldo dan fotonya Private Sub CBOAgt_Click() Call BukaDB RSAnggota.Open"select*from tblanggota where no_anggota='" &CBOAgt&"'",Conn If RSAnggota.EOF Then MsgBox "Nomor anggota tidak terdaftar" CBOAgt.SetFocus Exit Sub Else Nama = RSAnggota!Nama Saldo = Format(RSAnggota!Saldo,"##,###,###") FolderFoto = RSAnggota!lokasi 'Picture1.Picture = LoadPicture(RSAnggota!foto) End If End Sub

'pada saat nomor anggota dipilih dalam combo, tampilkan nama anggota, saldo dan fotonya Private Sub CBOAgt_KeyPress(Keyascii As Integer) If Keyascii = 13 Then Call BukaDB RSAnggota.Open"select*from tblanggota where no_anggota='"&CBOAgt&"'",Conn


If RSAnggota.EOF Then MsgBox "Nomor anggota tidak terdaftar" CBOAgt.SetFocus Exit Sub Else Nama = RSAnggota!Nama Saldo = Format(RSAnggota!Saldo,"##,###,###") Picture1.Picture = LoadPicture(RSAnggota!foto) JmlSimpan.SetFocus End If End If End Sub

Private Sub CmdInput_Click() If CmdInput.Caption = "&Input"Then CmdInput.Caption = "&Simpan" CmdTutup.Caption = "&Batal" CBOAgt.Enabled = True JmlSimpan.Enabled = True CBOAgt.SetFocus Exit Sub Else If CBOAgt =""Or JmlSimpan=""Then MsgBox "Data belum lengkap" Exit Sub Else 'simpan data ke tabel pinjam Dim simpan As String simpan="Insert into tblsimpan (no_simpan,tanggal,no_anggota,jmlsimpan,KODEKSR)values"&_ "('"&Nomor&"','"& CDate(Tanggal)&"','"&CBOAgt& "','"&JmlSimpan&"','"&MENU.StatusBar1.Panels(1)&"')" Conn.Execute simpan 'tambah saldo anggota dengan simpanan yang baru saja dilakukan Call BukaDB RSAnggota.Open"select*from tblanggota where no_anggota='"&CBOAgt&"'",Conn If Not RSAnggota.EOF Then Dim edit As String edit="update tblanggota set saldo='"& RSAnggota!Saldo + JmlSimpan&"'where no_anggota='"& CBOAgt &"'" Conn.Execute edit Call KondisiAwal


Form_Activate End If End If End If End Sub

Private Sub CmdTutup_Click() If CmdTutup.Caption="&Tutup"Then Unload Me ElseIf CmdTutup.Caption="&Batal"Then CBOAgt = "" Call KondisiAwal Form_Activate End If End Sub

Private Sub JmlSimpan_KeyPress(Keyascii As Integer) If Keyascii=13 Then JmlSimpan=Format(JmlSimpan, "##,###,###") CmdInput.SetFocus End If End Sub

Source Code Form Pinjaman Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Program koperasi safwan\Program Koperasi\DBKOPERASI.mdb" Adodc1.RecordSource = "TBLPinjam" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Call NoPinjam Tanggal = Format(Date, "DD-MMM-YYYY") End Sub

Private Sub NoPinjam() Call BukaDB RSPinjam.Open"select*from TBLPinjam Where NO_Pinjam In(Select Max(NO_Pinjam)From TBLPinjam)Order By NO_Pinjam Desc", Conn


RSPinjam.Requery Dim Urutan As String*12 Dim Hitung As Long With RSPinjam If .EOF Then Urutan="PJM" + Format(Date,"yymmdd")+"001" Nomor = Urutan Else If Min (!No_Pinjam, 4, 6)<>Format(Data, “yymmdd”) Then Urutan="PJM"+Format(Date,"yymmdd")+ "001" Else Hitung=Right(!No_Pinjam,9)+1 Urutan = "PJM" + Format(Date, "yymmdd")+ Right("000"&Hitung,3) End If End If Nomor = Urutan End With End Sub

Private Sub Form_Load() Call BukaDB RSAnggota.Open"select*from tblanggota",Conn CBOAgt.Clear Do While Not RSAnggota.EOF CBOAgt.AddItem RSAnggota!no_anggota RSAnggota.MoveNext Loop CBOAgt.Enabled = False JmlPinjam.Enabled = False End Sub

Sub KondisiAwal() CBOAgt = "" Nama = "" Saldo = "" JmlPinjam = "" Picture1.Picture = LoadPicture() CBOAgt.Enabled = False JmlPinjam.Enabled = False CmdInput.Caption = "&Input" CmdTutup.Caption = "&Tutup" End Sub


Private Sub CBOAgt_Click() Call BukaDB RSAnggota.Open"select*from tblanggota where no_anggota='" & CBOAgt & "'",Conn If RSAnggota.EOF Then MsgBox "Nomor anggota tidak terdaftar" CBOAgt.SetFocus Exit Sub Else Nama=RSAnggota!Nama Saldo=Format(RSAnggota!Saldo, "##,###,###") If Saldo <= 100000 Then MsgBox "Anda tidak dapat meminjam uang"& _ "karena ini saldo minimal" JmlPinjam.Enabled = False End If End If End Sub Private Sub CBOAgt_KeyPress(Keyascii As Integer) If Keyascii = 13 Then Call BukaDB RSAnggota.Open"select*from tblanggota where no_anggota='"&CBOAgt & "'",Conn If RSAnggota.EOF Then MsgBox "Nomor anggota tidak terdaftar" CBOAgt.SetFocus Exit Sub Else Nama = RSAnggota!Nama Saldo = Format(RSAnggota!Saldo,"##,###,###") Picture1.Picture = LoadPicture(RSAnggota!foto) JmlPinjam.SetFocus End If End If End Sub

Private Sub CmdInput_Click() If CmdInput.Caption = "&Input" Then CmdInput.Caption = "&Simpan" CmdTutup.Caption = "&Batal" CBOAgt.Enabled = True JmlPinjam.Enabled = True CBOAgt.SetFocus Exit Sub


Else If CBOAgt=""Or JmlPinjam="" Then MsgBox "Data belum lengkap" Exit Sub Else Dim Pinjam As String Pinjam="Insert into tblPinjam (no_Pinjam,tanggal,no_anggota,jmlPinjam,KODEKSR)values"&_ "('" & Nomor & "','" & CDate(Tanggal) & "','" & CBOAgt & "','" & JmlPinjam & "','" & MENU.StatusBar1.Panels(1) & "')" Conn.Execute Pinjam Call BukaDB RSAnggota.Open "select*from tblanggota where no_anggota='" & CBOAgt & "'", Conn If Not RSAnggota.EOF Then Dim edit As String edit="update tblanggota set saldo='"& RSAnggota!Saldo-JmlPinjam&"' where no_anggota='"&CBOAgt& "'" Conn.Execute edit Call KondisiAwal Form_Activate End If End If End If End Sub

Private Sub CmdTutup_Click() If CmdTutup.Caption="&Tutup"Then Unload Me ElseIf CmdTutup.Caption="&Batal"Then CBOAgt="" Call KondisiAwal Form_Activate End If End Sub Private Sub JmlPinjam_KeyPress(Keyascii As Integer) If Keyascii=13 Then If JmlPinjam>Saldo-100000 Then MsgBox "jumlah pinjaman terlalu besar, sisa saldo minimal Rp 100,000" JmlPinjam.SetFocus Exit Sub


Else JmlPinjam = Format(JmlPinjam, "##,###,###") CmdInput.SetFocus End If End If End Sub

Source Code Form Laporan Pinjam Private Sub Form_Load() Call BukaDB RSPinjam.Open"select distinct (no_anggota) from tblPinjam", Conn Do While Not RSPinjam.EOF Combo1.AddItem RSPinjam!no_anggota RSPinjam.MoveNext Loop Conn.Close Call BukaDB RSPinjam.Open "select distinct tanggal from tblPinjam", Conn Do While Not RSPinjam.EOF Combo2.AddItem Format(RSPinjam!Tanggal,"DD-MMM-YYYY") Combo3.AddItem Format(RSPinjam!Tanggal,"YYYY,MM, DD") Combo4.AddItem Format(RSPinjam!Tanggal,"YYYY,MM, DD") RSPinjam.MoveNext Loop Conn.Close

Call BukaDB Dim RSBLN As New ADODB.Recordset RSBLN.Open "select distinct month(tanggal) as Bulan from TBLPinjam", Conn Do While Not RSBLN.EOF Combo5.AddItem RSBLN!BULAN & Space(5) & MonthName(RSBLN!BULAN) RSBLN.MoveNext Loop Conn.Close Call BukaDB Dim RSTHN As New ADODB.Recordset


RSTHN.Open "select distinct year(tanggal) tblPinjam", Conn Do While Not RSTHN.EOF Combo6.AddItem RSTHN!TAHUN Combo7.AddItem RSTHN!TAHUN RSTHN.MoveNext Loop Conn.Close

as Tahun from

End Sub

'lap per anggota Private Sub Combo1_Click() CR.SelectionFormula="{tblPinjam.no_anggota}='"& Combo1&"'" CR.ReportFileName=App.Path&"\lap Pinjaman per anggota.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub

'lap harian Private Sub Combo2_Click() CR.SelectionFormula="totext({tblPinjam.tanggal})='"& CDate(Combo2)&"'" CR.ReportFileName=App.Path&"\lap Pinjaman per tanggal.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub 'lap mingguan Private Sub Combo4_Click() If Combo3="" Then MsgBox"Tanggal awal kosong",,"Informasi" Combo3.SetFocus Exit Sub Else If Combo4Combo4 Then MsgBox"Tanggal terbalik" Combo4.SetFocus Exit Sub


ElseIf Combo4 = Combo3 Then MsgBox "pilih tanggal yang berbeda" Combo4.SetFocus Exit Sub End If End If CR.SelectionFormula="{TBLPinjam.Tanggal}in date("& Combo3&")to date("&Combo4&")" CR.ReportFileName=App.Path&"\Lap Pinjaman per minggu.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub 'lap bulanan Private Sub Combo6_Click() Call BukaDB RSPinjam.Open"select*from TBLPinjam where month(tanggal)='"&Val(Left(Combo5,2))&"'and year(tanggal)='"&(Combo6)&"'",Conn If RSPinjam.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Combo4.SetFocus End If CR.SelectionFormula="Month({TBLPinjam.Tanggal})="& Val(Left(Combo5,2))&"and Year({TBLPinjam.Tanggal})="& Val(Combo6.Text) CR.ReportFileName=App.Path&"\Lap Pinjaman per bulan.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub

'lap tahunan Private Sub Combo7_Click() CR.SelectionFormula="year({TBLPinjam.Tanggal})="& Val(Combo7.Text) CR.ReportFileName=App.Path&"\Lap Pinjaman tahunan.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub


Source Code Form Laporan Simpan Private Sub Form_Load() 'buka database,buka tabel anggota dan tampilkan Nomor anggota di dalam combo 'nomor anggota yang tampil berulang disatukan dengan distinct Call BukaDB RSSimpan.Open"select distinct(no_anggota)from tblsimpan", Conn Do While Not RSSimpan.EOF Combo1.AddItem RSSimpan!no_anggota RSSimpan.MoveNext Loop Conn.Close Call BukaDB 'buka tblsimpan dan tampilkan tanggal dalam combo berikutnya dengan format tertentu RSSimpan.Open "select distinct tanggal from tblsimpan", Conn Do While Not RSSimpan.EOF Combo2.AddItem Format(RSSimpan!Tanggal,"DD-MMM-YYYY") Combo3.AddItem Format(RSSimpan!Tanggal,"YYYY,MM, DD") Combo4.AddItem Format(RSSimpan!Tanggal,"YYYY,MM, DD") RSSimpan.MoveNext Loop Conn.Close

Call BukaDB 'buatlah sebuah recordset baru Dim RSBLN As New ADODB.Recordset 'buka recordset baru tersebut dengan mengambil angka dan nama bulan dari data tanggalnya di TBLsimpan RSBLN.Open"select distinct month(tanggal) as Bulan from TBLsimpan",Conn Do While Not RSBLN.EOF Combo5.AddItem RSBLN!BULAN&Space(5)& MonthName(RSBLN!BULAN)


RSBLN.MoveNext Loop Conn.Close Call BukaDB Dim RSTHN As New ADODB.Recordset 'ambillah data tahun dari tblsimpan dan tampilkan dalam combo6 dan 7 RSTHN.Open "select distinct year(tanggal) as Tahun from tblsimpan", Conn Do While Not RSTHN.EOF Combo6.AddItem RSTHN!TAHUN Combo7.AddItem RSTHN!TAHUN RSTHN.MoveNext Loop Conn.Close End Sub

'lap per anggota Private Sub Combo1_Click() CR.SelectionFormula = "{tblsimpan.no_anggota}='" & Combo1 & "' " CR.ReportFileName=App.Path&"\lap simpanan per anggota.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub

'lap harian Private Sub Combo2_Click() CR.SelectionFormula="totext({tblsimpan.tanggal})='"& CDate(Combo2)&"'" CR.ReportFileName=App.Path&"\lap simpanan per tanggal.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action=1 End Sub 'lap mingguan Private Sub Combo4_Click() If Combo3=""Then


MsgBox "Tanggal awal kosong",,"Informasi" Combo3.SetFocus Exit Sub Else If Combo4< Combo3 Or Combo3 >Combo4 Then MsgBox"Tanggal terbalik" Combo4.SetFocus Exit Sub ElseIf Combo4=Combo3 Then MsgBox "pilih tanggal yang berbeda" Combo4.SetFocus Exit Sub End If End If CR.SelectionFormula="{TBLSIMPAN.Tanggal}in date("& Combo3&")to date("&Combo4&")" CR.ReportFileName = App.Path & "\Lap simpanan per minggu.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub

'lap bulanan Private Sub Combo6_Click() Call BukaDB RSSimpan.Open"select*from TBLsimpan where month(tanggal)='"&Val(Left(Combo5,2))&"'and year(tanggal)='"&(Combo6)&"'",Conn If RSSimpan.EOF Then MsgBox "Data tidak ditemukan" Exit Sub Combo4.SetFocus End If CR.SelectionFormula="Month({TBLsimpan.Tanggal})="& Val(Left(Combo5,2))&"and Year({TBLsimpan.Tanggal})="& Val(Combo6.Text) CR.ReportFileName=App.Path & "\Lap simpanan bulanan.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub


'lap tahunan Private Sub Combo7_Click() CR.SelectionFormula="year({TBLsimpan.Tanggal})="& Val(Combo7.Text) CR.ReportFileName=App.Path&"\Lap simpanan per tahun.rpt" CR.WindowState = crptMaximized CR.RetrieveDataFiles CR.Action = 1 End Sub


LAMPIRAN B : OUTPUT PROGRAM

1. Tampilan Menu Utama

2. Tampilan Menu Data Anggota


3. Tampilan Menu Simpan Dana

4. Tampilan Menu Pinjam Dana


5. Tampilan Menu Penyimpanan Dana

6. Tampilan Menu Peminjaman Dana


7. Laporan Penyimpanan Dana Per Minggu

8. Laporan Penyimpanan Dana Bulanan


9. Laporan Penyimpanan Dana Tahunan

10. Laporan Peminjaman Dana Per Minggu


11. Laporan Peminjaman Dana Bulanan

12. Laporan Peminjaman Dana Tahunan


LAMPIRAN A : LISTING PROGRAM

Recommend Documents