LISTING PROGRAM

MENU PASSWORD

Private Sub Command1_Click()

If Text1.Text = "rudijosen@yahoo.co.id" And Text2.Text =

"29071982" Then

PESAN = MsgBox("NAMA DAN PASSWORD ANDA BENAR", vbInformation,

"SUCCES")

Form5.Show

Unload Me

Else

PESAN = MsgBox("COBA LAGI", vbYesNo + vbQuestion, "PENYUSUP")

If PESAN = 8 Then

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

Else

Unload Me

End If

End If

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text2.SetFocus

End If

End Sub
MENU UTAMA

Private Sub MA_Click()

Form7.Show

End Sub

Private Sub MC_Click()

Form3.Show

End Sub

Private Sub MDR_Click()

DataReport1.Show

End Sub

Private Sub MED_Click()

Form2.Show

End Sub

Private Sub MEN_Click()

Form1.Show

End Sub

Private Sub MEX_Click()

Unload Me

End Sub

Private Sub MH_Click()

Form4.Show

End Sub
Private Sub MK_Click()

Unload Me

End Sub

SIMPAN DATA

Dim dataku As Database

Dim RSDATA As Recordset

Private Sub Command1_Click()

RSDATA.AddNew

RSDATA!NO_PENDAFTARAN = Text1.Text

RSDATA!TGL_PENDAFTARAN = Text2.Text

RSDATA!NAMA_PEMOHON = Text3.Text

RSDATA!NAMA_KECAMATAN = Text4.Text

RSDATA!NAMA_DESA = Text5.Text

RSDATA!LUAS_TANAH = Text6.Text

RSDATA!BIAYA_PENDAFTARAN = Text7.Text

RSDATA.Update

tanya = MsgBox("TAMBAH DATA LAGI", vbYesNo, "ENTRY DATA")

If tanya = vbYes Then

Text2.SetFocus

Else

Command3.SetFocus

End If

Text1.SetFocus

End Sub

Private Sub Command2_Click()

Text1.Text = ""
Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

End Sub

Private Sub Form_Load()

Set dataku = OpenDatabase("E:\TA\BPN TA.mdb")

Set RSDATA = dataku.OpenRecordset("TA")

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub BERSIH()

Call BERSIH1

End Sub

Private Sub Text1_Change()

Dim panjang As Byte

panjang = Len(Text1.Text)

If panjang < 4 Then

Exit Sub

End If

RSDATA.Index = "TABPN"

RSDATA.Seek "=", Text1.Text

Text2.SetFocus

Exit Sub

End If

Text2.Text = RSDATA!TGL_PENDAFTARAN

Text3.Text = RSDATA!NAMA_PEMOHON

Text4.Text = RSDATA!NAMA_KECAMATAN

Text5.Text = RSDATA!NAMA_DESA

Text6.Text = RSDATA!LUAS_TANAH

Text7.Text = RSDATA!BIAYA_PENDAFTARAN

MsgBox "DATA SUDAH ADA", vbInformation, "ENTRY DATA"

Exit Sub

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text2.SetFocus

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text3.SetFocus

End If

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
Text4.SetFocus

End If

End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text5.SetFocus

End If

End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text6.SetFocus

End If

End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text7.SetFocus

End If

End Sub

EDIT DATA

Dim dataku As Database

Dim RSDATA As Recordset

Private Sub Command1_Click()

RSDATA.Edit
RSDATA!NO_PENDAFTARAN = Text1.Text

RSDATA!TGL_PENDAFTARAN = Text2.Text

RSDATA!NAMA_PEMOHON = Text3.Text

RSDATA!NAMA_KECAMATAN = Text4.Text

RSDATA!NAMA_DESA = Text5.Text

RSDATA!LUAS_TANAH = Text6.Text

RSDATA!BIAYA_PENDAFTARAN = Text7.Text

RSDATA.Update

tanya = MsgBox("EDIT DATA LAGI", vbYesNo, "ENTRY DATA")

If tanya = vbYes Then

Text2.SetFocus

Else

Command3.SetFocus

End If

End Sub

Private Sub Form_Activate()

Text1.SetFocus

End Sub

Private Sub Form_Load()

Set dataku = OpenDatabase("E:\TA\BPN TA.mdb")

Set RSDATA = dataku.OpenRecordset("TA")

End Sub

Private Sub Command2_Click()

Text1.Text = ""
Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub BERSIH()

Call BERSIH1

End Sub

Private Sub Text1_Change()

Dim panjang As Byte

panjang = Len(Text1.Text)

If panjang < 4 Then

Exit Sub

End If

Command1.Enabled = True

RSDATA.Index = "TABPN"

RSDATA.Seek "=", Text1.Text

If RSDATA.NoMatch Then

Text2.SetFocus

Exit Sub
End If

Text2.Text = RSDATA!TGL_PENDAFTARAN

Text3.Text = RSDATA!NAMA_PEMOHON

Text4.Text = RSDATA!NAMA_KECAMATAN

Text5.Text = RSDATA!NAMA_DESA

Text6.Text = RSDATA!LUAS_TANAH

Text7.Text = RSDATA!BIAYA_PENDAFTARAN

tanya1 = MsgBox("DATA AKAN DI EDIT", vbYesNo, "ENTRY DATA")

If tanya1 = vbYes Then

Text2.SetFocus

Else

Command1.Enabled = False

Exit Sub

End If

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text2.SetFocus

End If

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text3.SetFocus

End If

End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text4.SetFocus

End If

End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text5.SetFocus

End If

End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text6.SetFocus

End If

End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text7.SetFocus

End If

End Sub

CARI DATA

Dim dataku As Database

Dim RSDATA As Recordset

Private Sub Command3_Click()

End Sub

Private Sub BERSIH()

Call BERSIH1

End Sub

Private Sub Form_Activate()

Call KONDISI

End Sub

Private Sub Form_Load()

Set dataku = OpenDatabase("E:\TA\BPN TA.mdb")

Set RSDATA = dataku.OpenRecordset("TA")

End Sub

Private Sub Text1_Change()

Dim panjang As Byte

panjang = Len(Text1.Text)

If panjang < 4 Then

Exit Sub

End If

RSDATA.Index = "TABPN"

RSDATA.Seek "=", Text1.Text

If RSDATA.NoMatch Then

tanya2 = MsgBox("DATA TIDAK DITEMUKAN", vbInformation, "CARI

DATA")

Text1.Text = ""

Text1.SetFocus
Exit Sub

End If

Text2.Text = RSDATA!TGL_PENDAFTARAN

Text3.Text = RSDATA!NAMA_PEMOHON

Text4.Text = RSDATA!NAMA_KECAMATAN

Text5.Text = RSDATA!NAMA_DESA

Text6.Text = RSDATA!LUAS_TANAH

Text7.Text = RSDATA!BIAYA_PENDAFTARAN

tanya1 = MsgBox("CARI DATA LAGI", vbYesNo, "CARI DATA")

If tanya1 = vbYes Then

Call BERSIH1

Text1.SetFocus

Else

Call BERSIH1

Command3.SetFocus

Exit Sub

End If

End Sub

Private Sub BERSIH1()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

End Sub
Private Sub KONDISI()

Text2.Enabled = False

Text3.Enabled = False

Text4.Enabled = False

Text5.Enabled = False

Text6.Enabled = False

Text7.Enabled = False

Command1.Enabled = False

End Sub

Private Sub AKTIF()

Text2.Enabled = True

Text3.Enabled = True

Text4.Enabled = True

Text5.Enabled = True

Text6.Enabled = True

Text7.Enabled = True

Command1.Enabled = True

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Text2.SetFocus

End If

End Sub
HAPUS DATA

Dim dataku As Database

Dim RSDATA As Recordset

Private Sub Command1_Click()

tanya3 = MsgBox("DATA BENAR AKAN DI HAPUS", vbYesNo, "HAPUS DATA")

If tanya3 = vbYes Then

RSDATA.Delete

Call BERSIH1

Else

End If

Exit Sub

tanya1 = MsgBox("HAPUS DATA LAGI", vbYesNo, "HAPUS DATA")

If tanya1 = vbYes Then

Text1.Text = ""

Text1.SetFocus

Exit Sub

End If

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub Form_Activate()

Call KONDISI

Text1.SetFocus

End Sub
Private Sub Form_Load()

Set dataku = OpenDatabase("E:\TA\BPN TA.mdb")

Set RSDATA = dataku.OpenRecordset("TA")

End Sub

Private Sub KONDISI()

Text2.Enabled = True

Text3.Enabled = True

Text4.Enabled = True

Text5.Enabled = True

Text6.Enabled = True

Text7.Enabled = True

Command1.Enabled = True

End Sub

Private Sub Text1_Change()

Dim panjang As Byte

panjang = Len(Text1.Text)

If panjang < 4 Then

Exit Sub

End If

RSDATA.Index = "TABPN"

RSDATA.Seek "=", Text1.Text

If RSDATA.NoMatch Then

tanya2 = MsgBox("DATA TIDAK DITEMUKAN", vbInformation, "HAPUS

DATA")

Text1.Text = ""

Text1.SetFocus
Exit Sub

End If

Text2.Text = RSDATA!TGL_PENDAFTARAN

Text3.Text = RSDATA!NAMA_PEMOHON

Text4.Text = RSDATA!NAMA_KECAMATAN

Text5.Text = RSDATA!NAMA_DESA

Text6.Text = RSDATA!LUAS_TANAH

Text7.Text = RSDATA!BIAYA_PENDAFTARAN

Command3.SetFocus

End Sub

Private Sub BERSIH1()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

End Sub

MENU ABOUT

Private Sub Command1_Click()

PESAN = MsgBox("ANDA MAU KELUAR????", vbYesNo,

"YUK...MARRRRIIEE!!!")

If PESAN = vbYes Then

Unload Me
End If

End Sub

Private Sub Form_Load()

Text1.Text = "RUDI JOSEN A.SIMBOLON"

Text2.Text = "PEMATANGSIANTAR/29 JULI 1982"

Text3.Text = "JLN.DALIL TANI II,GG.TOMAT NO.5"

Text4.Text = "MUSIC & FISHING"

Text5.Text = "PENGUSAHA"

End Sub