Listing Program. 1. FrmUser.frm

Listing Program 1. FrmUser.frm Private Sub cmdHapus_Click() If cmdHapus.Caption = "&Hapus" Then cmdInput.Enabled = False cmdTutup.Caption = "&Batal" KosongkanText SiapIsi cboUserName.SetFocus Call BukaDB RSUser.Open "data_user", Conn cboUserName.Clear Do Until RSUser.EOF cboUserName.AddItem RSUser!user_name RSUser.MoveNext Loop End If End Sub Private Sub cboUserName_Click() Call CariData Call TampilkanData If cmdHapus.Enabled = True Then Call CariData If Not RSUser.EOF Then TampilkanData pesan = MsgBox("Yakin akan dihapus", vbYesNo) If pesan = vbYes Then Dim SQLHapus As String SQLHapus = "Delete From data_user where user_name= '" & cboUserName & "'" Conn.Execute SQLHapus MsgBox "Data Berhasil Dihapus", vbInformation, "Informasi" Form_Activate Call KondisiAwal Else Form_Activate Call KondisiAwal End If Else MsgBox "Data Tidak ditemukan" cboUserName.SetFocus End If End If End Sub

Universitas Sumatera Utara

Private Sub cmdTutup_Click() Select Case cmdTutup.Caption Case "&Tutup" Me.Hide frmMenuUtama.Enabled = True frmMenuUtama.SetFocus frmMenuUtama.mnDataSekolah.Enabled = False frmMenuUtama.mnDataSiswa.Enabled = False frmMenuUtama.mnDataGuru.Enabled = False frmMenuUtama.mnInformasi.Enabled = False frmMenuUtama.mnLogin.Enabled = True Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSI.mdb" Adodc1.RecordSource = "data_user" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Adodc1.Visible = False Call TidakSiapIsi End Sub Function CariData() Call BukaDB RSUser.Open "Select * From data_user where user_name ='" & cboUserName & "'", Conn End Function Private Sub KosongkanText() cboUserName = "" txtPassword = "" cboStatusUser = "" End Sub Sub Isi_ComboStatusUser() cboStatusUser.Clear cboStatusUser.AddItem "Administrator" cboStatusUser.AddItem "User" End Sub Private Sub SiapIsi() 'enabled = true menyebabkan objek dpt dimasuki kursor


cboUserName.Enabled = True txtPassword.Enabled = True cboStatusUser.Enabled = True Call Isi_ComboStatusUser End Sub Private Sub TidakSiapIsi() 'enabled = false menyebabkan objek tdk dpt dimasuki kursor cboUserName.Enabled = False txtPassword.Enabled = False cboStatusUser.Enabled = False End Sub Private Sub KondisiAwal() Form_Activate KosongkanText TidakSiapIsi cmdInput.Caption = "&Daftar" cmdHapus.Caption = "&Hapus" cmdTutup.Caption = "&Tutup" cmdInput.Enabled = True cmdHapus.Enabled = True End Sub Sub Isi_ComboSex() cboSex.Clear cboSex.AddItem "Pria" cboSex.AddItem "Wanita" End Sub Private Sub TampilkanData() With RSUser cboUserName = RSUser!user_name txtPassword = RSUser!Password cboStatusUser = RSUser!status_user End With End Sub Private Sub cmdInput_Click() If cmdInput.Caption = "&Daftar" Then cmdInput.Caption = "&Simpan" cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" SiapIsi KosongkanText cboUserName.SetFocus Else If cboUserName = "" Or txtPassword = "" Or cboStatusUser = "" Then MsgBox "Data Belum Lengkap...!"


Exit Sub Else Dim SQLTambah As String SQLTambah = "Insert Into data_user values " & _ "('" & cboUserName & "','" & txtPassword & "','" & cboUserName & "')" Conn.Execute SQLTambah Form_Activate MsgBox "Data berhasil disimpan" _ , vbInformation, "Perhatian" Call KondisiAwal End If End If End Sub

2. FrmLogin.frm Private Sub cmdCancel_Click() Me.Hide frmMenuUtama.Enabled = True frmMenuUtama.SetFocus frmMenuUtama.mnDataSekolah.Enabled = False frmMenuUtama.mnDataSiswa.Enabled = False frmMenuUtama.mnDataGuru.Enabled = False frmMenuUtama.mnInformasi.Enabled = False frmMenuUtama.mnAboutMe.Enabled = False frmMenuUtama.mnLogin.Enabled = True End Sub Private Sub cmdOke_Click() Call BukaDB RSUser.Open "select * from data_user where user_name='" & txtUserName.Text & "'", Conn If RSUser.EOF Then MsgBox "Maaf, Anda tidak dapat masuk ke dalam Sistem ini!", vbCritical, "User Name" txtUserName.Text = "" txtPassword.Text = "" txtUserName.SetFocus Else If txtPassword.Text = RSUser!Password Then frmMenuUtama.Enabled = True frmMenuUtama.Show frmMenuUtama.mnDataSekolah.Enabled = True frmMenuUtama.mnDataSiswa.Enabled = True frmMenuUtama.mnDataGuru.Enabled = True frmMenuUtama.mnInformasi.Enabled = True frmMenuUtama.mnLogoff.Enabled = True


frmMenuUtama.mnAboutMe.Enabled = True frmMenuUtama.mnRegister.Enabled = False frmMenuUtama.mnLogin.Enabled = False Unload Me Else MsgBox "Password yang Anda masukkan tidak dikenali", vbCritical, "Password" txtPassword.Text = "" txtPassword.SetFocus End If End If End Sub Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSI.mdb" Adodc1.RecordSource = "data_user" Adodc1.Visible = False End Sub Private Sub Form_Load() txtUserName.Text = "" txtPassword.Text = "" Load frmMenuUtama frmMenuUtama.Show frmMenuUtama.Enabled = False Call BukaDB End Sub Private Sub txtPassword_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdOke_Click End If End Sub Private Sub txtUserName_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtPassword.SetFocus txtPassword.SelStart = 0 txtPassword.SelLength = Len(txtPassword) End If End Sub

3. frmIdentitasSekolah.frm


Private Sub cmdEdit_Click() If cmdEdit.Caption = "&Edit" Then cmdInput.Enabled = False cmdEdit.Caption = "&Simpan" cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" SiapIsi txtNama.SetFocus Else If txtKepsek = "" Or txtTU = "" Or txtTlpn = "" Or txtRegistrasi = "" Then MsgBox "Masih Ada Data Yang Kosong" Else 'edit data Dim SQLEdit As String kepsek = txtKepsek txtKepsek = Replace(txtKepsek, "'", "''") SQLEdit = "Update data_sekolah Set kepsek= '" & txtKepsek & "', tu='" & txtTU & "', tlpn='" & txtTlpn & "',registrasi='" & txtRegistrasi & "',alamat='" & txtAlamat & "',kabupaten='" & txtKabupaten & "',kota='" & txtKota & "',fax='" & txtFax & "',email='" & txtEmai & "',website='" & txtWebsite & "' where nama='" & txtNama & "'" Conn.Execute SQLEdit Form_Activate Call KondisiAwal End If End If End Sub Private Sub cmdHapus_Click() Dim pil Dim SQLHapus As String pil = MsgBox("Apakah Anda yakin data ini akan dihapus ?", vbQuestion + vbYesNo + vbDefaultButton2, "Konfirmasi") If pil = vbYes Then SQLHapus = "delete from data_sekolah where registrasi='" & Adodc1.Recordset!registrasi & "'" Adodc1.Recordset.Delete MsgBox "Data Berhasil Dihapus !", vbInformation, "Informasi" End If End Sub Private Sub cmdTutup_Click() Select Case cmdTutup.Caption Case "&Tutup"


Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSI.mdb" Adodc1.RecordSource = "data_sekolah" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Adodc1.Visible = False Call TidakSiapIsi End Sub Private Sub KosongkanText() txtNama = "" txtKepsek = "" txtTU = "" txtTlpn = "" txtRegistrasi = "" txtAlamat = "" txtKabupaten = "" txtKota = "" txtFax = "" txtEmail = "" txtWebsite = "" End Sub Private Sub SiapIsi() 'enabled = true menyebabkan objek dpt dimasuki kursor txtNama.Enabled = True txtKepsek.Enabled = True txtTU.Enabled = True txtTlpn.Enabled = True txtRegistrasi.Enabled = True txtAlamat.Enabled = True txtKabupaten.Enabled = True txtKota.Enabled = True txtFax.Enabled = True txtEmail.Enabled = True txtWebsite.Enabled = True End Sub Private Sub TidakSiapIsi() 'enabled = false menyebabkan objek tdk dpt dimasuki kursor txtNama.Enabled = False


txtKepsek.Enabled = False txtTU.Enabled = False txtTlpn.Enabled = False txtRegistrasi.Enabled = False txtAlamat.Enabled = False txtKabupaten.Enabled = False txtKota.Enabled = False txtFax.Enabled = False txtEmail.Enabled = False txtWebsite.Enabled = False End Sub Private Sub TampilkanData() With RSSekolah If Not RSSekolah.EOF Then txtNama = RSSekolah!nama txtKepsek = RSSekolah!kepsek txtTU = RSSekolah!tu txtTlpn = RSSekolah!tlpn txtRegistrasi = RSSekolah!registrasi txtAlamat = RSSekolah!alamat txtKabupaten = RSSekolah!kabupaten txtKota = RSSekolah!kota txtFax = RSSekolah!fax txtEmail = RSSekolah!email txtWebsite = RSSekolah!website End If End With End Sub Function CariData() Call BukaDB RSSekolah.Open "Select * From data_sekolah where nama='" & txtNama & "'", Conn End Function Private Sub KondisiAwal() Form_Activate KosongkanText TidakSiapIsi cmdInput.Caption = "&Input" 'cmdEdit.Caption = "&Edit" cmdHapus.Caption = "&Hapus" cmdTutup.Caption = "&Tutup" cmdInput.Enabled = True 'cmdEdit.Enabled = True cmdHapus.Enabled = True End Sub Private Sub cmdInput_Click() If cmdInput.Caption = "&Input" Then cmdInput.Caption = "&Simpan" 'cmdEdit.Enabled = False cmdHapus.Enabled = False


cmdTutup.Caption = "&Batal" SiapIsi KosongkanText txtNama.SetFocus Else If txtNama = "" Or txtKepsek = "" Or txtTU = "" Or txtTlpn = "" Or txtRegistrasi = "" Then MsgBox "Data Belum Lengkap...!" Exit Sub Else Dim SQLTambah As String SQLTambah = "Insert Into data_sekolah (nama,kepsek,tu,tlpn,registrasi,alamat,kabupaten,kot a,fax,email,website) values " & _ "('" & txtNama & "','" & txtKepsek & "','" & txtTU & "','" & txtTlpn & "','" & txtRegistrasi & "','" & txtAlamat & "','" & txtKabupaten & "','" & txtKota & "','" & txtFax & "','" & txtEmail & "','" & txtWebsite & "')" Conn.Execute SQLTambah Form_Activate MsgBox "Data berhasil disimpan" _ , vbInformation, "Perhatian" Call KondisiAwal End If End If End Sub Private Sub txtNama_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then 'If cmdInput.Caption = "&Simpan" Then Call CariData If Not RSSekolah.EOF Then TampilkanData MsgBox "Data Sekolah Sudah Ada" KosongkanText txtNama.SetFocus Else txtKepsek.SetFocus End If 'If cmdEdit.Caption = "&Simpan" Then Call CariData If Not RSSekolah.EOF Then TampilkanData txtNama.Enabled = False txtKepsek.SetFocus Else 'MsgBox "Kode Barang Tidak Ada"


'txtNama = "" 'txtNama.SetFocus End If ' End If End If 'End If End Sub Private Sub txtKepsek_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTU.SetFocus End Sub Private Sub txtTu_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTlpn.SetFocus End Sub Private Sub txtTlpn_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtRegistrasi.SetFocus End Sub Private Sub txtRegistrasi_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtAlamat.SetFocus End Sub Private Sub txtAlamat_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtKabupaten.SetFocus End Sub Private Sub txtKabupaten_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtKota.SetFocus End Sub Private Sub txtKota_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtFax.SetFocus End Sub Private Sub txtFax_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtEmail.SetFocus End Sub Private Sub txtEmail_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtWebsite.SetFocus End Sub

4. frmDataSiswaBaru.frm Private Sub cboNoSiswa_KeyPress(KeyAscii As Integer)


KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then If Len(cboNoSiswa) < 3 Or Len(cboNoSiswa) > 3 Then MsgBox "Kode Harus Angka & 3 Digit, Contoh '001'" cboNoSiswa.SetFocus cboNoSiswa.Clear Exit Sub Else txtNama.SetFocus End If If cmdInput.Caption = "&Simpan" Then Call CariData If Not RSSiswa.EOF Then TampilkanData MsgBox "Data Siswa sudah ada", vbInformation, "Informasi" KosongkanText cboSex.Clear cboNoSiswa.SetFocus Else txtNama.SetFocus End If End If End If End Sub Private Sub AutoNomor() Call BukaDB RSSiswa.Open ("select * from data_siswa Where no_siswa In(Select Max(no_siswa)From data_siswa)Order By no_siswa Desc"), Conn RSSiswa.Requery Dim Urutan As String * 6 Dim Hitung As Long With RSSiswa If .EOF Then Urutan = "001" cboNoSiswa = Urutan Else Hitung = Right(!no_siswa, 4) + 1 Urutan = Right("00" & Hitung, 4) End If cboNoSiswa = Urutan End With End Sub Private Sub cmdEdit_Click() perhatian2.Visible = True


If cmdEdit.Caption = "&Edit" Then cmdInput.Enabled = False cmdEdit.Caption = "&Simpan" cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" SiapIsi cboNoSiswa.SetFocus Call BukaDB RSSiswa.Open "data_siswa", Conn cboNoSiswa.Clear Do Until RSSiswa.EOF cboNoSiswa.AddItem RSSiswa!no_siswa RSSiswa.MoveNext Loop Else If cboNoSiswa = "" Or txtNama = "" Or txtTempatLahir = "" Or DTPicker1 = "" Or cboSex = "" Or txtTlpn = "" Then MsgBox "Masih Ada Data Yang Kosong" Else Dim SQLEdit As String SQLEdit = "Update data_siswa Set nama= '" & txtNama & "',tempat_lahir='" & txtTempatLahir & "',tgl_lahir='" & DTPicker1 & "',sex='" & cboSex & "',tlpn='" & txtTlpn & "',alamat='" & txtAlamat & "',sekolah_asal= '" & txtSekolahAsal & "' where no_siswa='" & cboNoSiswa & "'" Conn.Execute SQLEdit Form_Activate MsgBox "Data Berhasil Diedit ", vbInformation, "Informasi" Call KondisiAwal End If End If End Sub Private Sub cmdHapus_Click() perhatian2.Visible = True If cmdHapus.Caption = "&Hapus" Then cmdInput.Enabled = False cmdEdit.Enabled = False cmdTutup.Caption = "&Batal" KosongkanText SiapIsi cboNoSiswa.SetFocus Call BukaDB RSSiswa.Open "data_siswa", Conn cboNoSiswa.Clear Do Until RSSiswa.EOF cboNoSiswa.AddItem RSSiswa!no_siswa


RSSiswa.MoveNext Loop End If End Sub Private Sub cboNoSiswa_Click() Call CariData Call TampilkanData If cmdHapus.Enabled = True Then Call CariData If Not RSSiswa.EOF Then TampilkanData pesan = MsgBox("Yakin akan dihapus", vbYesNo) If pesan = vbYes Then Dim SQLHapus As String SQLHapus = "Delete From data_siswa where no_siswa= '" & cboNoSiswa & "'" Conn.Execute SQLHapus MsgBox "Data Berhasil Dihapus", vbInformation, "Informasi" Form_Activate Call KondisiAwal Else Form_Activate Call KondisiAwal End If Else MsgBox "Data Tidak ditemukan" cboNoSiswa.SetFocus End If End If End Sub Private Sub cmdTutup_Click() Select Case cmdTutup.Caption Case "&Tutup" Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub Form_Activate() Call BukaDB Adodc1.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSI.mdb" Adodc1.RecordSource = "data_siswa"


Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Adodc1.Visible = False Call TidakSiapIsi End Sub Function CariData() Call BukaDB RSSiswa.Open "Select * From data_siswa where no_siswa='" & cboNoSiswa & "'", Conn End Function Private Sub KosongkanText() cboNoSiswa = "" txtNama = "" txtTempatLahir = "" cboSex = "Pria" txtTlpn = "" txtAlamat = "" txtSekolahAsal = "" End Sub Private Sub SiapIsi() 'enabled = true menyebabkan objek dpt dimasuki kursor cboNoSiswa.Enabled = True txtNama.Enabled = True txtTempatLahir.Enabled = True DTPicker1.Enabled = True cboSex.Enabled = True Call Isi_ComboSex txtTlpn.Enabled = True txtAlamat.Enabled = True txtSekolahAsal.Enabled = True End Sub Private Sub TidakSiapIsi() 'enabled = false menyebabkan objek tdk dpt dimasuki kursor cboNoSiswa.Enabled = False txtNama.Enabled = False txtTempatLahir.Enabled = False DTPicker1.Enabled = False cboSex.Enabled = False txtTlpn.Enabled = False txtAlamat.Enabled = False txtSekolahAsal.Enabled = False perhatian.Visible = False perhatian2.Visible = False End Sub Private Sub KondisiAwal()


Form_Activate KosongkanText TidakSiapIsi cmdInput.Caption = "&Input" cmdEdit.Caption = "&Edit" cmdHapus.Caption = "&Hapus" cmdTutup.Caption = "&Tutup" cmdInput.Enabled = True cmdEdit.Enabled = True cmdHapus.Enabled = True End Sub Sub Isi_ComboSex() cboSex.Clear cboSex.AddItem "PRIA" cboSex.AddItem "WANITA" End Sub Private Sub TampilkanData() With RSSiswa cboNoSiswa = RSSiswa!no_siswa txtNama = RSSiswa!nama txtTempatLahir = RSSiswa!tempat_lahir DTPicker1 = RSSiswa!tgl_lahir Call Isi_ComboSex cboSex = RSSiswa!sex txtTlpn = RSSiswa!tlpn txtAlamat = RSSiswa!alamat txtSekolahAsal = RSSiswa!sekolah_asal End With End Sub Private Sub cmdInput_Click() perhatian.Visible = True If cmdInput.Caption = "&Input" Then cmdInput.Caption = "&Simpan" cmdEdit.Enabled = False cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" SiapIsi KosongkanText Call AutoNomor cboNoSiswa.Enabled = False txtNama.SetFocus 'cboNoSiswa.SetFocus Else If cboNoSiswa = "" Or txtNama = "" Or txtTempatLahir = "" Or DTPicker1 = "" Or cboSex = "" Then MsgBox "Data Belum Lengkap...!"


Exit Sub Else Dim SQLTambah As String SQLTambah = "Insert Into data_siswa (no_siswa,nama,tempat_lahir,tgl_lahir,sex,tlpn,alama t,sekolah_asal) values " & _ "('" & cboNoSiswa & "','" & txtNama & "','" & txtTempatLahir & "','" & DTPicker1 & "','" & cboSex & "','" & txtTlpn & "','" & txtAlamat & "','" & txtSekolahAsal & "')" Conn.Execute SQLTambah Form_Activate MsgBox "Data berhasil disimpan" _ , vbInformation, "Perhatian" Call KondisiAwal End If End If End Sub Private Sub Form_Load() txtNama.MaxLength = 30 txtTempatLahir.MaxLength = 80 txtTlpn.MaxLength = 15 txtAlamat.MaxLength = 80 txtSekolahAsal.MaxLength = 30 End Sub Private Sub txtNama_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTempatLahir.SetFocus Exit Sub End Sub Private Sub txtTempatLahir_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then DTPicker1.SetFocus End Sub

Private Sub DTPicker1_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cboSex.SetFocus End Sub Private Sub cboSex_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTlpn.SetFocus End Sub


Private Sub txtTlpn_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtAlamat.SetFocus End Sub Private Sub txtAlamat_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtSekolahAsal.SetFocus End Sub Private Sub txtSekolahAsal_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cmdInput.SetFocus End Sub 5.frmKelengkapanDataSiswa.frm Public baru As Boolean '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=" & App.Path & "\dbSI.mdb" Adodc1.RecordSource = "data_siswa" Adodc1.Refresh Set DataGrid1.DataSource = Adodc1 DataGrid1.Refresh Adodc1.Visible = False Adodc2.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSI.mdb" Adodc2.RecordSource = "kelengkapan_data_siswa" Adodc2.Refresh Set DataGrid2.DataSource = Adodc2 DataGrid2.Refresh Adodc2.Visible = False End Sub Sub Form_Load() Call KondisiAwal End Sub Function CariData() Call BukaDB RSSiswa.Open "Select * From data_siswa where no_siswa='" & cboNoSiswa & "'", Conn


End Function Function CariData2() Call BukaDB RSSiswa2.Open "Select * From kelengkapan_data_siswa where no_siswa='" & cboNoSiswa2 & "'", Conn End Function Private Sub KosongkanText() cboNoSiswa2 = "" txtNoInduk = "" txtNisn = "" txtNama = "" txtTempatLahir = "" cboSex = "" cboGolda = "" cboKewarganegaraan = "" cboAgama = "" txtAlamat = "" txtTlpn = "" txtHp = "" txtSekolahAsal = "" txtNoIjazah = "" txtLokasi = "" End Sub Private Sub SiapIsi() 'enabled = true menyebabkan objek dpt dimasuki kursor cboNoSiswa.Enabled = True cboNoSiswa2.Enabled = True txtNoInduk.Enabled = True txtNisn.Enabled = True txtNama.Enabled = True txtTempatLahir.Enabled = True DTPicker1.Enabled = True cboSex.Enabled = True Call Isi_ComboSex cboGolda.Enabled = True Call Isi_ComboGolda cboKewarganegaraan.Enabled = True Call Isi_ComboKewarganegaraan cboAgama.Enabled = True Call Isi_ComboAgama txtAlamat.Enabled = True txtTlpn.Enabled = True txtHp.Enabled = True txtSekolahAsal.Enabled = True txtNoIjazah.Enabled = True DTPicker2.Enabled = True


txtLokasi.Enabled = True Picture1.Enabled = True perhatian.Visible = True perhatian2.Visible = True End Sub Private Sub TidakSiapIsi() 'enabled = false menyebabkan objek tdk dpt dimasuki kursor cboNoSiswa.Enabled = False cboNoSiswa2.Enabled = False txtNoInduk.Enabled = False txtNisn.Enabled = False txtNama.Enabled = False txtTempatLahir.Enabled = False DTPicker1.Enabled = False cboSex.Enabled = False cboGolda.Enabled = False cboKewarganegaraan.Enabled = False cboAgama.Enabled = False txtAlamat.Enabled = False txtTlpn.Enabled = False txtHp.Enabled = False txtSekolahAsal.Enabled = False txtNoIjazah.Enabled = False DTPicker2.Enabled = False txtLokasi.Enabled = False Picture1.Enabled = False perhatian.Visible = False perhatian2.Visible = False End Sub Private Sub KondisiAwal() Form_Activate KosongkanText TidakSiapIsi cmdInput.Caption = "&Input" cmdEdit.Caption = "&Edit" cmdHapus.Caption = "&Hapus" cmdTutup.Caption = "&Tutup" cmdInput.Enabled = True cmdEdit.Enabled = True cmdHapus.Enabled = True End Sub Private Sub TampilkanData() With RSSiswa cboNoSiswa2 = RSSiswa!no_siswa txtNama = RSSiswa!nama txtTempatLahir = RSSiswa!tempat_lahir


DTPicker1 = RSSiswa!tgl_lahir Call Isi_ComboSex cboSex = RSSiswa!sex txtTlpn = RSSiswa!tlpn txtAlamat = RSSiswa!alamat txtSekolahAsal = RSSiswa!sekolah_asal 'Picture1.Picture = LoadPicture(RSSiswa!foto) End With End Sub Private Sub TampilkanData2() With RSSiswa2 txtNoInduk = RSSiswa2!no_induk txtNisn = RSSiswa2!nisn txtNama = RSSiswa2!nama txtTempatLahir = RSSiswa2!tempat_lahir DTPicker1 = RSSiswa2!tgl_lahir Call Isi_ComboSex cboSex = RSSiswa2!sex Call Isi_ComboGolda cboGolda = RSSiswa2!golda Call Isi_ComboKewarganegaraan cboKewarganegaraan = RSSiswa2!kewarganegaraan Call Isi_ComboAgama cboAgama = RSSiswa2!agama txtAlamat = RSSiswa2!alamat txtTlpn = RSSiswa2!tlpn txtAlamat = RSSiswa2!alamat txtSekolahAsal = RSSiswa2!sekolah_asal txtNoIjazah = RSSiswa2!no_ijazah 'DTPicker2 = RSSiswa2!tgl_ijazah txtLokasi = RSSiswa2!lokasi 'Picture1.Picture = LoadPicture(RSSiswa!foto) End With End Sub Sub Isi_ComboSex() cboSex.Clear cboSex.AddItem "PRIA" cboSex.AddItem "WANITA" End Sub Sub Isi_ComboGolda() cboGolda.Clear cboGolda.AddItem "A" cboGolda.AddItem "B" cboGolda.AddItem "AB" cboGolda.AddItem "0" End Sub


Sub Isi_ComboKewarganegaraan() cboKewarganegaraan.Clear cboKewarganegaraan.AddItem "INDONESIA" cboKewarganegaraan.AddItem "ASING" End Sub Sub Isi_ComboAgama() cboAgama.Clear cboAgama.AddItem "KATOLIK" cboAgama.AddItem "PROTESTAN" cboAgama.AddItem "HINDU" cboAgama.AddItem "BUDHA" End Sub Private Sub cmdInput_Click() If cmdInput.Caption = "&Input" Then cmdInput.Caption = "&Simpan" cmdEdit.Enabled = False cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" cboNoSiswa.Clear SiapIsi perhatian.Visible = False perhatian2.Visible = False KosongkanText cboNoSiswa2.SetFocus Else If cboNoSiswa2 = "" Or txtNoInduk = "" Or txtNisn = "" Or txtNama = "" Then MsgBox "Data Belum Lengkap...!" ElseIf txtLokasi = "" 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 kelengkapan_data_siswa (no_siswa,no_induk,nisn,nama,tempat_lahir,tgl_lahir, sex,golda,kewarganegaraan,agama,alamat,tlpn,hp,sekol ah_asal,no_ijazah,tgl_ijazah,lokasi,foto) values " & _ "('" & cboNoSiswa2 & "','" & txtNoInduk & "','" & txtNisn & "','" & txtNama & "','" & txtTempatLahir & "','" & DTPicker1 & "','" & cboSex & "','" & cboGolda & "','" & cboKewarganegaraan & "','" & cboAgama & "','" & txtAlamat & "','" & txtTlpn & "','" & txtHp & "','" & txtSekolahAsal


&"','" & txtNoIjazah & "','" & DTPicker2 & "','" & txtLokasi & "','" & Picture1 & "')" Conn.Execute SQLTambah Form_Activate Call KondisiAwal End If End If End Sub Private Sub cmdEdit_Click() If cmdEdit.Caption = "&Edit" Then cmdInput.Enabled = False cmdEdit.Caption = "&Simpan" cmdHapus.Enabled = False cmdTutup.Caption = "&Batal" SiapIsi perhatian2.Visible = False cboNoSiswa.SetFocus Call BukaDB RSSiswa.Open "data_siswa", Conn cboNoSiswa.Clear Do Until RSSiswa.EOF cboNoSiswa.AddItem RSSiswa!no_siswa RSSiswa.MoveNext Loop Else If cboNoSiswa2 = "" Or txtNama = "" Or txtTempatLahir = "" Or Picture1 = "" Then MsgBox "Masih Ada Data Yang Kosong" Else Dim SQLEdit As String SQLEdit = "Update kelengkapan_data_siswa Set no_siswa ='" & cboNoSiswa2 & "',no_induk= '" & txtNoInduk & "',nisn='" & txtNisn & "',nama='" & txtNama & "',tempat_lahir='" & txtTempatLahir & "',tgl_lahir='" & DTPicker1 & "',sex='" & cboSex & "',golda='" & cboGolda & "',kewarganegaraan='" & cboKewarganegaraan & "',agama='" & cboAgama & "',alamat='" & txtAlamat & "',tlpn='" & txtTlpn & "',hp='" & txtHp & "',sekolah_asal='" & txtSekolahAsal & "',no_ijazah='" & txtNoIjazah & "',tgl_ijazah='" & DTPicker2 & "',lokasi='" & txtLokasi & "',foto='" & Picture1.Picture & "' where no_siswa='" & cboNoSiswa2 & "'" Conn.Execute SQLEdit Form_Activate Dim SQLTambah As String SQLTambah = "Insert Into kelengkapan_data_siswa (no_siswa,no_induk,nisn,nama,tempat_lahir,tgl_lahir,


sex,golda,kewarganegaraan,agama,alamat,tlpn,hp,sekol ah_asal,no_ijazah,tgl_ijazah,lokasi,foto) values " & _ "('" & cboNoSiswa2 & "','" & txtNoInduk & "','" & txtNisn & "','" & txtNama & "','" & txtTempatLahir & "','" & DTPicker1 & "','" & cboSex & "','" & cboGolda & "','" & cboKewarganegaraan & "','" & cboAgama & "','" & txtAlamat & "','" & txtTlpn & "','" & txtHp & "','" & txtSekolahAsal & "','" & txtNoIjazah & "','" & DTPicker2 & "','" & txtLokasi & "','" & Picture1 & "')" Conn.Execute SQLTambah Form_Activate Call KondisiAwal End If End If End Sub Private Sub cmdHapus_Click() If cmdHapus.Caption = "&Hapus" Then cmdInput.Enabled = False cmdEdit.Enabled = False cmdTutup.Caption = "&Batal" KosongkanText SiapIsi perhatian.Visible = False cboNoSiswa2.SetFocus End If End Sub Private Sub cmdTutup_Click() Select Case cmdTutup.Caption Case "&Tutup" Unload Me Case "&Batal" TidakSiapIsi KondisiAwal End Select End Sub Private Sub cboNoSiswa_Click() Call CariData Call TampilkanData cboNoSiswa2.SetFocus End Sub Private Sub cboNoSiswa2_Click() Call CariData2 Call TampilkanData2 cboNoSiswa2.SetFocus


End Sub Private Sub cboNoSiswa2_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then If Len(cboNoSiswa2) < 3 Or Len(cboNoSiswa2) > 3 Then MsgBox "Kode Harus Angka & 3 Digit, Contoh '001'" cboNoSiswa2.SetFocus cboNoSiswa2.Clear Exit Sub Else cboNoSiswa2.SetFocus cboNoSiswa.Clear End If If cmdInput.Enabled = True Then Call CariData2 If Not RSSiswa2.EOF Then CariData2 TampilkanData2 MsgBox "Data Siswa Telah Diinput" KosongkanText Else txtNama.SetFocus End If End If End If If cmdHapus.Enabled = True Then Call CariData2 If Not RSSiswa2.EOF Then TampilkanData2 Dim pesan As String pesan = MsgBox("Yakin akan dihapus", vbYesNo) If pesan = vbYes Then Dim SQLHapus As String SQLHapus = "Delete From kelengkapan_data_siswa where no_siswa= '" & cboNoSiswa2 & "'" Conn.Execute SQLHapus KondisiAwal Form_Activate Else KondisiAwal cmdHapus.SetFocus End If


Else 'MsgBox "Data Tidak ditemukan" 'cboNoSiswa2.SetFocus End If End If End Sub Private Sub Picture1_Click() cdlg1.ShowOpen txtLokasi = cdlg1.FileName 'FolderFoto = Cdlg1.InitDir 'FolderFoto = UCase(Left(Cdlg1.FileName, Len(Cdlg1.FileName) - Len(Cdlg1.FileTitle))) End Sub Private Sub txtNoSiswa2_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtNoInduk.SetFocus End Sub Private Sub txtNoInduk_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtNisn.SetFocus End Sub

Private Sub txtNisn_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtNama.SetFocus End Sub Private Sub txtNama_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTempatLahir.SetFocus End Sub Private Sub txtTempatLahir_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then DTPicker1.SetFocus End Sub Private Sub DTPicker1_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cboSex.SetFocus End Sub Private Sub cboSex_KeyPress(KeyAscii As Integer)


KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cboGolda.SetFocus End Sub Private Sub cboGolda_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cboKewarganegaraan.SetFocus End Sub Private Sub cboKewarganegaraan_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then cboAgama.SetFocus End Sub Private Sub cboAgama_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtAlamat.SetFocus End Sub

Private Sub txtAlamat_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtTlpn.SetFocus End Sub Private Sub txtTlpn_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtHp.SetFocus End Sub Private Sub txtHp_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtSekolahAsal.SetFocus End Sub Private Sub txtSekolahAsal_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then txtNoIjazah.SetFocus End Sub Private Sub txtNoIjazah_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) If KeyAscii = 13 Then DTPicker2.SetFocus End Sub Private Sub txtLokasi_Change() Picture1.Picture = LoadPicture(txtLokasi) End Sub


DEPARTEMEN PENDIDIKAN NASIONAL

UNIVERSITAS SUMATERA UTARA FAKULTAS MATEMATIKA DAN ILMU PENGETAHUAN ALAM(FMIPA)

Jl. Bioteknologi No.1 Kampus USU Telp. (061) 8211050 Fax (061) 8214290 MEDAN – 20155, Email : [email protected]

KARTU BIMBINGAN TUGAS AKHIR MAHASISWA

Nama Mahasiswa

: Ronald Wesli P

Nomor Stambuk

: 092406148

Judul Tugas Akhir

: Sistem Informasi Siswa dan Guru Pada SMA Swasta RK Bintang Timur Rantauprapat Menggunakan VB 6.0 Studi Kasus : Para Siswa dan Guru

Dosen Pembimbing

: Drs.Sawaluddin,M.IT

Tanggal Mulai Bimbingan

: 13 April 2012

Tanggal Selesai Bimbingan : 8 Juni 2012

No

*

TANGGAL ASISTEN BIMBINGAN

PEMBAHASAN PARAF PADA ASISTENSI DOSEN KETERANGAN MENGENAI, PEMBIMBING PADA BAB 13 April 2012 Proposal Tugas Akhir 29 Mei 2012 Bab 1 1 Juni 2012 Bab 2 5 Juni 2012 Bab 3 5 Juni 2012 Bab 4 5 Juni 2012 Bab 5 8 Juni 2012 Pengujian Program Kartu ini harap dikembalikan ke Departemen Matematika bila bimbingan telah selesai.

Diketahui: Ketua Departemen Matematika,

Dr. Prof. Tulus, M.Si NIP : 196209011988031002

Disetujui Pembimbing Utama/ Penanggung Jawab

Drs.Sawaluddin,M.IT NIP : 195912311998021001



Listing Program. 1. FrmUser.frm

Recommend Documents