Selasa, 04 Desember 2012

Tutorial Membuat Aplikasi Input Data Pegawai


Tutorial Membuat Aplikasi 

Input Data Pegawai



Kali ini saya akan membuat Tutorial aplikasi tentang Input Data Pegawai menggunakan Visual Basic Enterprise 6.0 dan microsoft acces

Pertama:
siapakan aplikasi sebagai berikut : 
Visual Basic Enterprise 6.0 dan Ms.Acces(disini saya menggunakan versi 2007)

Kedua:
Ikuti Tutorial Berikut ini:
Buat lah Form login


Kemudian isi source sebagai berikut :
Private Sub Command1_Click()
sambung
sql = "select * from login where nama = '" & Text1.Text & "' and pass = '" & Text2.Text & "'"
Set rs = con.Execute(sql)
If Not rs.EOF Then
With menu
.Show
.inp.Enabled = True
.car.Enabled = True
.cetak.Enabled = True
.us.Enabled = True
.keluar.Enabled = True
.Command1.Enabled = True
.Command2.Enabled = True
.Command3.Enabled = True
End With
Unload Me
Else
MsgBox ("Periksa user dan password anda, kayaknya salah deh..."), vbInformation, "Oopzz......"
Text1.Text = ""
Text2.Text = ""
Text1.SetFocus
End If
End Sub

Private Sub Command2_Click()
End
End Sub

Kemudian buat Form Menu nya

Kemudian isi source sebagai berikut :
Private Sub car_Click()
cari.Show
End Sub

Private Sub cetak_Click()
karyawan.Show
End Sub

Private Sub Command1_Click()
input_data.Show
End Sub

Private Sub Command2_Click()
cari.Show
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub inp_Click()
input_data.Show
End Sub

Private Sub kami_Click()
kami.Show
menu.Hide
End Sub

Private Sub keluar_Click()
End
End Sub

Private Sub MDIForm_Load()
inp.Enabled = False
car.Enabled = False
cetak.Enabled = False
us.Enabled = False
keluar.Enabled = False
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
End Sub

Private Sub us_Click()
user.Show
End Sub

kemudian buatlah from cari data

Kemudian isi source sebagai berikut :

Private Sub Command1_Click()
On Error GoTo salah
sambung
If Option1.Value = True Then
input_data.Text_nip.Text = Text1.Text
sql = "select * from karyawan where nip = '" & input_data.Text_nip.Text & "'"
Set rs = con.Execute(sql)
Else
input_data.Text_nama.Text = Text1.Text
sql = "select * from karyawan where nama = '" & input_data.Text_nama.Text & "'"
Set rs = con.Execute(sql)
End If
input_data.Text_nip.Text = rs.Fields(0)
input_data.Text_nama.Text = rs.Fields(1)
input_data.Text_namais.Text = rs.Fields(2)
input_data.tgl_is.Text = rs.Fields(3)
input_data.Text_a1.Text = rs.Fields(4)
input_data.tgl1.Text = rs.Fields(5)
input_data.Text_a2.Text = rs.Fields(6)
input_data.tgl2.Text = rs.Fields(7)
input_data.Text_a3.Text = rs.Fields(8)
input_data.tgl3.Text = rs.Fields(9)
input_data.Text_a4.Text = rs.Fields(10)
input_data.tgl4.Text = rs.Fields(11)
input_data.Text_a5.Text = rs.Fields(12)
input_data.tgl5.Text = rs.Fields(13)
input_data.Show
Exit Sub
salah:
MsgBox ("Data Tidak Ditemukan"), vbInformation, "Not Found"
Text1 = ""
Text1.SetFocus
input_data.keluar = True
End Sub

Private Sub Command2_Click()
Text1.Text = ""
Text1.SetFocus
tampil ("select * from karyawan")
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
Me.Height = 6555
Me.Left = 4740
Me.Top = 1000
Me.Width = 6375
tampil ("select * from karyawan")
Option1.Value = False
Option2.Value = False
End Sub

Function tampil(strsql As String)
sambung
LvKaryawan.ListItems.Clear
Dim data As ListItem
If rs.State = 1 Then rs.Close
rs.Open strsql, con, adOpenDynamic, adLockOptimistic
    While Not rs.EOF
        Set data = LvKaryawan.ListItems.Add(, , rs.Fields(0))
            data.SubItems(1) = rs.Fields(1)
            data.SubItems(2) = rs.Fields(2)
        rs.MoveNext
    Wend
End Function

Private Sub Option1_Click()
tampil ("select * from karyawan order by nip")
Text1.SetFocus
End Sub

Private Sub Option2_Click()
tampil ("select * from karyawan order by nama")
Text1.SetFocus
End Sub

Private Sub Text1_Change()
If Option1.Value = True Then
tampil ("select * from karyawan where nip like '" & Text1.Text & "%'")
Else
If Option2.Value = True Then
tampil ("select * from karyawan where nama like '" & Text1.Text & "%'")
Else
MsgBox ("pilih kriteria dulu ya...."), vbInformation, "Ooopz...."
End If
End If
End Sub

Private Sub LvKaryawan_Click()
If Option1.Value = True Then
    If rs.State = 1 Then rs.Close
        rs.Open "select * from karyawan where [nip] = '" & LvKaryawan.SelectedItem & "'", con
        Text1.Text = rs.Fields(0)
Else
    If rs.State = 1 Then rs.Close
        rs.Open "select * from karyawan where [nip] = '" & LvKaryawan.SelectedItem & "'", con
        Text1.Text = rs.Fields(1)
End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1.SetFocus
End Sub

kemudian buatlah Form input data Pegawai

Kemudian isi source sebagai berikut :
Private Sub baru_Click()
bersih
aktiv
Text_nip.SetFocus
baru.Enabled = False
simpan.Enabled = True
batal.Enabled = True
End Sub

Private Sub batal_Click()
bersih
Text_nip.SetFocus
batal.Enabled = False
baru.Enabled = True
End Sub

Private Sub Command2_Click()

End Sub

Private Sub cetak_Click()
sambung
report
lap1.DataControl1.Source = "select * from karyawan where nip = '" & Text_nip.Text & "'"
lap1.Show
lap1.WindowState = maximized
End Sub

Private Sub edit_Click()
aktiv
Text_nip.Enabled = False
edit.Enabled = False
simpan.Enabled = True
Text_nama.SetFocus
End Sub

Private Sub Form_Load()
Me.Height = 8595
Me.Left = 4000
Me.Top = 200
Me.Width = 7830

pasif
simpan.Enabled = False
batal.Enabled = False
tampil ("select * from karyawan")
End Sub

Private Sub hapus_Click()
If MsgBox("apakah anda yakin ingin menghapus?", vbYesNo, "Warning..") = vbYes Then
sambung
sql = "delete from karyawan where nip = '" & Text_nip.Text & "'"
con.Execute (sql)
bersih

hapus.Enabled = True
tampil ("select * from karyawan")
End If
End Sub

Private Sub keluar_Click()
Unload Me
End Sub

Private Sub simpan_Click()
If Text_nip.Enabled = True Then
sambung
sql = "insert into karyawan values('" & Text_nip.Text & "', '" & Text_nama.Text & "', '" & Text_namais.Text & "','" & tgl_is.Text & "','" & Text_a1.Text & "','" & tgl1.Text & "','" & Text_a2.Text & "','" & tgl2.Text & "','" & Text_a3.Text & "','" & tgl3.Text & "','" & Text_a4.Text & "','" & tgl4.Text & "','" & Text_a5.Text & "','" & tgl5.Text & "') "
con.Execute (sql)
Else
sql = "update karyawan set nama = '" & Text_nama.Text & "', nama_is = '" & Text_namais.Text & "', tgl_is = '" & tgl_is.Text & "', nama1 = '" & Text_a1.Text & "', tgl1 = '" & tgl1.Text & "', nama2 = '" & Text_a2.Text & "', tgl2 = '" & tgl2.Text & "', nama3 = '" & Text_a3.Text & "', tgl3 = '" & tgl3.Text & "', nama4 = '" & Text_a4.Text & "', tgl4 = '" & tgl4.Text & "', nama5 = '" & Text_a5.Text & "', tgl5 = '" & tgl5.Text & "' where nip = '" & Text_nip.Text & "'"
con.Execute (sql)
End If
pasif
tampil ("select * from karyawan")
simpan.Enabled = False
baru.Enabled = True
End Sub

Private Sub Text_a1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl1.SetFocus
End Sub

Private Sub Text_a2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl2.SetFocus
End Sub

Private Sub Text_a3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl3.SetFocus
End Sub

Private Sub Text_a4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl4.SetFocus
End Sub

Private Sub Text_a5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl5.SetFocus
End Sub

Private Sub Text_nama_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_namais.SetFocus
End Sub

Private Sub Text_namais_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then tgl_is.SetFocus
End Sub

Private Sub Text_nip_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_nama.SetFocus
End Sub

Private Sub tgl_is_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_a1.SetFocus
End Sub

Private Sub tgl1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_a2.SetFocus
End Sub

Private Sub tgl2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_a3.SetFocus
End Sub

Private Sub tgl3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_a4.SetFocus
End Sub

Private Sub tgl4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text_a5.SetFocus
End Sub

Private Sub tgl5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then simpan.SetFocus
End Sub

Sub bersih()
Text_nip = ""
Text_nama = ""
Text_namais = ""
tgl_is = ""
Text_a1 = ""
Text_a2 = ""
Text_a3 = ""
Text_a4 = ""
Text_a5 = ""
tgl1 = ""
tgl2 = ""
tgl3 = ""
tgl4 = ""
tgl5 = ""
End Sub

Sub aktiv()
Text_nip.Enabled = True
Text_nama.Enabled = True
Text_namais.Enabled = True
tgl_is.Enabled = True
Text_a1.Enabled = True
Text_a2.Enabled = True
Text_a3.Enabled = True
Text_a4.Enabled = True
Text_a5.Enabled = True
tgl1.Enabled = True
tgl2.Enabled = True
tgl3.Enabled = True
tgl4.Enabled = True
tgl5.Enabled = True
End Sub

Sub pasif()
Text_nip.Enabled = False
Text_nama.Enabled = False
Text_namais.Enabled = False
tgl_is.Enabled = False
Text_a1.Enabled = False
Text_a2.Enabled = False
Text_a3.Enabled = False
Text_a4.Enabled = False
Text_a5.Enabled = False
tgl1.Enabled = False
tgl2.Enabled = False
tgl3.Enabled = False
tgl4.Enabled = False
tgl5.Enabled = False
End Sub

Function tampil(strsql As String)
sambung
LvKaryawan.ListItems.Clear
Dim data As ListItem
If rs.State = 1 Then rs.Close
rs.Open strsql, con, adOpenDynamic, adLockOptimistic
    While Not rs.EOF
        Set data = LvKaryawan.ListItems.Add(, , rs.Fields(0))
            data.SubItems(1) = rs.Fields(1)
            data.SubItems(2) = rs.Fields(2)
            data.SubItems(3) = rs.Fields(3)
            data.SubItems(4) = rs.Fields(4)
            data.SubItems(5) = rs.Fields(5)
            data.SubItems(6) = rs.Fields(6)
            data.SubItems(7) = rs.Fields(7)
            data.SubItems(8) = rs.Fields(8)
            data.SubItems(9) = rs.Fields(9)
            data.SubItems(10) = rs.Fields(10)
            data.SubItems(11) = rs.Fields(11)
            data.SubItems(12) = rs.Fields(12)
            data.SubItems(13) = rs.Fields(13)
        rs.MoveNext
    Wend
End Function

Private Sub LvKaryawan_Click()
    If rs.State = 1 Then rs.Close
        rs.Open "select * from karyawan where [nip] = '" & LvKaryawan.SelectedItem & "'", con
        Text_nip = rs.Fields(0)
        Text_nama = rs.Fields(1)
        Text_namais = rs.Fields(2)
        tgl_is = rs.Fields(3)
        Text_a1 = rs.Fields(4)
        tgl1 = rs.Fields(5)
        Text_a2 = rs.Fields(6)
        tgl2 = rs.Fields(7)
        Text_a3 = rs.Fields(8)
        tgl3 = rs.Fields(9)
        Text_a4 = rs.Fields(10)
        tgl4 = rs.Fields(11)
        Text_a5 = rs.Fields(12)
        tgl5 = rs.Fields(13)
End Sub

Sub report()
lap1.DataControl1.CursorLocation = ddADOUseClient
lap1.DataControl1.CursorType = ddADOOpenDynamic
lap1.DataControl1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\data.mdb;Persist Security Info=False"
End Sub

kemudian buatlah Form lihat data pegawai
ini sourcenya:
Function tampil(strsql As String)
sambung
LvKaryawan.ListItems.Clear
Dim data As ListItem
If rs.State = 1 Then rs.Close
rs.Open strsql, con, adOpenDynamic, adLockOptimistic
    While Not rs.EOF
        Set data = LvKaryawan.ListItems.Add(, , rs.Fields(0))
            data.SubItems(1) = rs.Fields(1)
            data.SubItems(2) = rs.Fields(2)
            data.SubItems(3) = rs.Fields(3)
            data.SubItems(4) = rs.Fields(4)
            data.SubItems(5) = rs.Fields(5)
            data.SubItems(6) = rs.Fields(6)
            data.SubItems(7) = rs.Fields(7)
            data.SubItems(8) = rs.Fields(8)
            data.SubItems(9) = rs.Fields(9)
            data.SubItems(10) = rs.Fields(10)
            data.SubItems(11) = rs.Fields(11)
            data.SubItems(12) = rs.Fields(12)
            data.SubItems(13) = rs.Fields(13)
        rs.MoveNext
    Wend
End Function

Private Sub Command1_Click()
If Option1.Value = True Then
report
lap2.DataControl1.Source = "select * from karyawan order by nip"
lap2.Show
lap2.WindowState = maximized
Else
report
lap2.DataControl1.Source = "select * from karyawan order by nama"
lap2.Show
lap2.WindowState = maximized
End If
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Form_Load()
tampil ("select * from karyawan")
End Sub

Sub report()
lap2.DataControl1.CursorLocation = ddADOUseClient
lap2.DataControl1.CursorType = ddADOOpenDynamic
lap2.DataControl1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\data.mdb;Persist Security Info=False"
End Sub

Private Sub Option1_Click()
tampil ("select * from karyawan order by nip")
End Sub

Private Sub Option2_Click()
tampil ("select * from karyawan order by nama")
End Sub

kemudian buat data user untuk mengganti admin
ini sourcenya :
Private Sub Command1_Click()
aktif
Text1 = ""
Text2 = ""
Text1.SetFocus
Command1.Enabled = False
Command4.Enabled = True
End Sub

Private Sub Command2_Click()
If MsgBox("Yaakinn....mau dihapus...???", vbYesNo, "Warning..") = vbYes Then
sambung
sql = "delete from login where nama = '" & Text1.Text & "'"
con.Execute (sql)
tampil ("select * from login")
Text1.Text = ""
Text2.Text = ""
Command2.Enabled = False
End If
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()
sambung
sql = "insert into login values('" & Text1.Text & "','" & Text2.Text & "')"
con.Execute (sql)
pasif
tampil ("select * from login")
Command1.Enabled = True
Command4.Enabled = False
End Sub

Private Sub Form_Load()
Me.Height = 5220
Me.Left = 5730
Me.Top = 2160
Me.Width = 4575
pasif
Command1.Enabled = True
Command4.Enabled = False
tampil ("select * from login")
End Sub

Function tampil(strsql As String)
sambung
LvUser.ListItems.Clear
Dim data As ListItem
If rs.State = 1 Then rs.Close
rs.Open strsql, con, adOpenDynamic, adLockOptimistic
    While Not rs.EOF
        Set data = LvUser.ListItems.Add(, , rs.Fields(0))
            data.SubItems(1) = rs.Fields(1)
        rs.MoveNext
    Wend
End Function

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text2.SetFocus
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command4.SetFocus
End Sub

Sub pasif()
Text1.Enabled = False
Text2.Enabled = False
End Sub

Sub aktif()
Text1.Enabled = True
Text2.Enabled = True
End Sub

Private Sub LvUser_Click()
    If rs.State = 1 Then rs.Close
        rs.Open "select * from login where [nama] = '" & LvUser.SelectedItem & "'", con
        Text1.Text = rs.Fields(0)
        Text2.Text = rs.Fields(1)
Command2.Enabled = True
End Sub

Ketiga :
buat database untuk menyimpan databuka MS.Acces nya buat bikin database
database data pegawai :


database admin buat login:

Selesai!!!!!!!!!!!!!!!!!!





5 komentar:

  1. Maaf sebelumnya, bisa kirim caranya yang lebih detail ke email sy uchufilda@yahoo.com. Mohon bantuannya krn sy ada tugas buat yang ini. Trima kasih

    BalasHapus
  2. Komentar ini telah dihapus oleh pengarang.

    BalasHapus
  3. kurang detail cara cara nya broo

    BalasHapus