program aplikasi work order pemesanan barang vb 6

Aplikasi Work Order Dan Akuntansi VB 6.0

Program ini merupakan sebuah ilustrasi tentang pemesanan barang bubut, seperti pintu gerbang, teralis jendela, pagar rumah, tangga dalam rumah dan sejenisnya. Pola ini dapat digunakan pada pemesanan barang yang lainnya.

Proses yang terjadi dalam program ini adalah sebagai berikut :

1.       Penyimpanan uang kas oleh pemilik perusahaan

2.       Pemesan datang meminta dibuatkan barang misalnya berupa pintu gerbang

3.       Pemilik perusahaan menyebutkan harga pembuatan barang pesanan tersebut

4.       Pemesan membayar uang muka atau dilunasi sekaligus

5.       Pemilik perusahaan membeli bahan baku yang diperlukan dan melakukan kalkulasi biaya pembuatan barang pesanan. Dalam proses inilah kalkulasi akuntasi terjadi

6.       Barang yang telah jadi dikirimkan kepada pemesan

7.       Pembuatan laporan pemesanan dan pengiriman barang

2.1 Merancang Database Dan Bentuk Relasi Tabel

Langkah awal yang harus dilakukan adalah membuat database dnegan nama DBAKN.mdb. kemudian membuat beberapa tabel yang diperlukan antara lain:

Relasi tabel pada program akuntansi terlihat pada gambar di bawah ini:

Itulah ilustrasi program pemesanan barang ini. Langkah berikutnya adalah membuat database sesuai dengan spesifikasi file yang disebutkan di atas, kemudian membuat project di VB. Agar akses ke database lebih efektif dan efisien maka sebaiknya dibuat sebuah module.

2.2 Membuat Module

·         Aktifkan VB

·         Klik menu project

·         Add module

·         Open

·         Ketiklah program berikut ini.

Public Conn As New ADODB.Connection

Public RSPerkiraan As ADODB.Recordset

Public RSPemesan As ADODB.Recordset

Public RSMasterPO As ADODB.Recordset

Public RSDetailPO As ADODB.Recordset

Public RSBukuBesar As ADODB.Recordset

Public RSKASIR As ADODB.Recordset

Public RSKas As ADODB.Recordset

Public RSArusKas As ADODB.Recordset

Public Sub BukaDB()

Set Conn = New ADODB.Connection

Set RSPerkiraan = New ADODB.Recordset

Set RSPemesan = New ADODB.Recordset

Set RSMasterPO = New ADODB.Recordset

Set RSDetailPO = New ADODB.Recordset

Set RSBukuBesar = New ADODB.Recordset

Set RSKASIR = New ADODB.Recordset

Set RSKas = New ADODB.Recordset

Set RSArusKas = New ADODB.Recordset

Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBAKN.mdb"

End Sub

2.3 Login

Koding :

Dim A As Byte

Dim B As Byte

Private Sub Form_Load()

TxtNamaKsr.MaxLength = 30

TxtPasswordKsr.MaxLength = 10

TxtPasswordKsr.PasswordChar = "X"

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 Kasir where NamaKsr ='" & TxtNamaKsr & "'", Conn

    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"

            Unload Me

        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 KodeKasir As String

Dim NamaKasir As String

If Keyascii = 13 Then

    Call BukaDB

    RSKASIR.Open "Select * from Kasir 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"

            Unload Me

        End If

    Else

        Unload Me

        Menu.Show

        Order.Caption = "Data Pesanan " & TxtNamaKsr

    End If

End If

End Sub

2.4 Kasir

2.5 Simpan Kas Sebagai Modal

Koding :

Private Sub Form_Load()

'buka database

Call BukaDB

'tanggal diambil dari sistem komputer

Tanggal = Date

End Sub

Private Sub Jumlah_KeyPress(Keyascii As Integer)

'jika menekan enter maka

If Keyascii = 13 Then

    'jika jumlah kosong atau jumlah nol maka

    If Jumlah = "" Or Jumlah = 0 Then

        'tampilkan pesan

        MsgBox "jumlah pemasukan masih kosong"

        Jumlah.SetFocus

        Exit Sub

    Else

        'jika jumlah telah diisi maka ubah formatnya

        Jumlah = Format(Jumlah, "###,###,###")

        'tampilkan pesan

        Pesan = MsgBox("Data sudah benar..?", vbYesNo)

        'jika pesan dibawaj YES maka

        If Pesan = vbYes Then

            Dim Simpankas As String

            'simpan data ke tabel kas, keterangan diambil dari caption form

            Simpankas = "insert into kas (tanggal,Keterangan,DEBET) values ('" & Tanggal & "','" & Kas.Caption & "','" & Jumlah & "')"

            Conn.Execute (Simpankas)

            Jumlah = ""

            Tanggal.SetFocus

        End If

    End If

End If

End Sub

2.6 Pemesan

2.7  Kode Perkiraan

2.8  Pemesanan Barang

Alur proses dalam program pemesanan barang ini adalah sebagai berikut :

1.              Nomor PO otomatis

2.              Mengisi data pemesan cukup dengan memilih atau mengetiknya dalam combo

3.              Isilah berapa jumlah ordernya

4.              Berapa uang muka yang dibayarkan

5.              Transaksi barang-barang yang diperlukan dalam pembuatan pesanan dimulai dengan memilih tanggal, kemudian diisi barang apa saja yang dibeli

6.              Kode barang atau account yang dibeli cukup dengan memilih dalam list kemudian menekan enter

7.              Setelah itu isilah berapa jumlah dana yang dikeluarkan untuk pembelian bahan-bahan pesanan tersebut.

 

2.9    Pengiriman Barang

2.10            Laporan

Pembuatan laporan dapat dilakukan selengkap mungkin yaitu :

1.              Laporan pemesanan per nomor faktur

2.              Laporan pemesanan harian, mingguan dan bulanan

3.              Laporan pemesanan yang sudah dikirim atau belum dikirim

4.              Laporan pemesanan yang sudah lunas atau belum lunas

5.              Laporan biaya-biaya (harian, mingguan dan bulanan)

6.              Laporan biaya-biaya per kode perkiraan

7.              Dan sebagainya

Langkah awalnya adalah membuat form dengan bentuk seperti gambar di bawah ini :

Koding :

Private Sub Form_Load()

Call BukaDB

'buka tabel masterpo

RSMasterPO.Open "Select * From MasterPO order By 1", Conn

RSMasterPO.Requery

Do Until RSMasterPO.EOF

    'tampilkan nomor po di combo6

    Combo6.AddItem RSMasterPO!NOPO

    RSMasterPO.MoveNext

Loop

Conn.Close

Call BukaDB

'buka tabel masterpo dan tampilkan field Ket1

RSMasterPO.Open "Select distinct Ket1 From MasterPO", Conn

RSMasterPO.Requery

Do Until RSMasterPO.EOF

    'tampilkan ket1 di combo7

    Combo7.AddItem RSMasterPO!ket1

    RSMasterPO.MoveNext

Loop

Conn.Close

Call BukaDB

RSMasterPO.Open "Select distinct Ket2 From MasterPO", Conn

RSMasterPO.Requery

Do Until RSMasterPO.EOF

    'tampilkan field ket2 di combo8

    Combo8.AddItem RSMasterPO!ket2

    RSMasterPO.MoveNext

Loop

Conn.Close

Call BukaDB

'buka tabel masterpo dan ambil tanggalnya saja

RSMasterPO.Open "Select Distinct TGLPO From MasterPO order By 1", Conn

RSMasterPO.Requery

Do Until RSMasterPO.EOF

    'tampilkan tglpo di combo1,2 dan 3

    Combo1.AddItem RSMasterPO!TglPO

    Combo2.AddItem Format(RSMasterPO!TglPO, "YYYY ,MM, DD")

    Combo3.AddItem Format(RSMasterPO!TglPO, "YYYY ,MM, DD")

    RSMasterPO.MoveNext

Loop

Conn.Close

Call BukaDB

Dim RSTGL As New ADODB.Recordset

RSTGL.Open "select distinct tGLpo from MASTERPO", Conn

Do While Not RSTGL.EOF

    'tampilkan tglpo berupa angka bulan di combo4

    Combo4.AddItem Format(RSTGL!TglPO, "MM")

    RSTGL.MoveNext

Loop

Conn.Close

Call BukaDB

Dim RSTHN As New ADODB.Recordset

RSTHN.Open "select distinct year(tGLpo)  as sss from MASTERPO", Conn

Do While Not RSTHN.EOF

    'tampilkan angka tahun di combo5

    Combo5.AddItem RSTHN!sss

    RSTHN.MoveNext

Loop

Conn.Close

End Sub

'lap per nomor po

Private Sub Combo6_Click()

    CR.SelectionFormula = "{MasterPO.NOPO}='" & Combo6 & "'"

    CR.ReportFileName = App.Path & "\Faktur order.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

'Lap Harian

Private Sub Combo1_Click()

    CR.SelectionFormula = "Totext({MasterPO.TGLPO})='" & Combo1 & "'"

    CR.ReportFileName = App.Path & "\Lap Order Harian.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

'Lap Mingguan (Tgl Antara)

Private Sub Combo3_Click()

    If Combo2 = "" Then

        MsgBox "TGLPO awal kosong", , "Informasi"

        Combo2.SetFocus

        Exit Sub

    Else

        If Combo3 < Combo2 Or Combo2 > Combo3 Then

            MsgBox "Tanggal terbalik"

            Exit Sub

        ElseIf Combo3 = Combo2 Then

            MsgBox "pilih tanggal yang berbeda"

            Exit Sub

        End If

    End If

    CR.SelectionFormula = "{MasterPO.TGLPO} in date (" & Combo2.Text & ") to date (" & Combo3.Text & ")"

    CR.ReportFileName = App.Path & "\Lap Order Mingguan.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

'Lap Bulanan

Private Sub Combo5_Click()

    Call BukaDB

    RSMasterPO.Open "select * from MasterPO where month(TGLPO)='" & Val(Combo4) & "' and year(TGLPO)='" & (Combo5) & "'", Conn

    If RSMasterPO.EOF Then

        MsgBox "Data tidak ditemukan"

        Exit Sub

        Combo4.SetFocus

    End If

   

    CR.SelectionFormula = "Month({MasterPO.TGLPO})=" & Val(Combo4.Text) & " and Year({MasterPO.TGLPO})=" & Val(Combo5.Text)

    CR.ReportFileName = App.Path & "\Lap Order Bulanan.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

Private Sub Combo7_Click()

    CR.SelectionFormula = "{MASTERPO.KET1}='" & Combo7 & "'"

    CR.ReportFileName = App.Path & "\Lap KET1.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

Private Sub Combo8_Click()

    CR.SelectionFormula = "{MASTERPO.KET2}='" & Combo8 & "'"

    CR.ReportFileName = App.Path & "\Lap KET2.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

2.10.1 Laporan Pemesanan Barang Per Nomor Faktur

2.10.2 Laporan Pemesanan Lunas / Belum Lunas

2.10.3 Laporan Pemesanan Dikirm / Belum Dikirim

2.11            Laporan arus kas

Sebelum membuat laporan arus kas, buatlah form dengan bentuk seperti gambar di bawah ini:

Koding :

Private Sub Form_Load()

'buka database

Call BukaDB

'buka tabel kas dan tampilkan tanggalnya secara terurut dari yang terkecil

RSKas.Open "Select Distinct Tanggal From Kas order By 1", Conn

RSKas.Requery

'tampilkan tanggal di combo1,2 dan 3

Do Until RSKas.EOF

    Combo1.AddItem RSKas!Tanggal

    Combo2.AddItem Format(RSKas!Tanggal, "YYYY ,MM, DD")

    Combo3.AddItem Format(RSKas!Tanggal, "YYYY ,MM, DD")

    RSKas.MoveNext

Loop

'definisikan recordset baru

Dim RSTGL As New ADODB.Recordset

'buka tabel kas dan ambil angka bulannya saja dari field tanggal

RSTGL.Open "select distinct Tanggal from Kas", Conn

'tampilkan berulang2 bulannya dengan format 2 angka

Do While Not RSTGL.EOF

    'tampilkan angka bulan di combo4

    Combo4.AddItem Format(RSTGL!Tanggal, "MM")

    RSTGL.MoveNext

Loop

'ciptakan recordset baru

Dim RSTHN As New ADODB.Recordset

'buka tabel kas dan ambil angka tahunya saja dari field tanggal

RSTHN.Open "select distinct year(Tanggal)  as sss from Kas", Conn

'tampilkan angka tahun di combo5

Do While Not RSTHN.EOF

    Combo5.AddItem RSTHN!sss

    RSTHN.MoveNext

Loop

Conn.Close

End Sub

'Lap Harian

Private Sub Combo1_Click()

    'saring laporan dari tabel kas yang tanggalnya dipilih di combo1

    CR.SelectionFormula = "Totext({Kas.Tanggal})='" & Combo1 & "'"

    'panggil file laporan lap arus kas harian

    CR.ReportFileName = App.Path & "\Lap arus kas harian.rpt"

    'tampilkan satu layar penuh

    CR.WindowState = crptMaximized

    'jika ada perubahan isi data maka data diupdate

    CR.RetrieveDataFiles

    'tampilkan ke layar

    CR.Action = 0

End Sub

'Lap Mingguan (Tgl Antara)

Private Sub Combo3_Click()

    'jika tanggal awal kosong, tampilkan pesan

    If Combo2 = "" Then

        MsgBox "Tanggal awal kosong", , "Informasi"

        Combo2.SetFocus

        Exit Sub

    Else

        'jika tanggal awal lebih besar dari tanggal akhir, tampilkan pesan

        If Combo3 < Combo2 Or Combo2 > Combo3 Then

            MsgBox "Tanggal terbalik"

            Exit Sub

        'jika tgl awal = tgl akhir, tampilkan pesan

        ElseIf Combo3 = Combo2 Then

            MsgBox "pilih tanggal yang berbeda"

            Exit Sub

        End If

    End If

    'jika semua pilihan sudah benar maka, saring laporang

    'yang tgl awalnya =combo2 dan tgl akhirnya=combo3

    CR.SelectionFormula = "{Kas.Tanggal} in date (" & Combo2.Text & ") to date (" & Combo3.Text & ")"

    'panggil file lap arus kas mingguan

    CR.ReportFileName = App.Path & "\Lap arus kas mingguan.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

'Lap Bulanan

Private Sub Combo5_Click()

    'sebelum lap dipanggil cek datanya dulu

    Call BukaDB

    'buka tabel kas yg bulan dan tahunnya dipilih di combo4 dan 5

    RSKas.Open "select * from Kas where month(Tanggal)='" & Val(Combo4) & "' and year(Tanggal)='" & (Combo5) & "'", Conn

    'jika data tidak ditemukan lap tidak usah diloading, tapi munculkan pesan

    If RSKas.EOF Then

        MsgBox "Data tidak ditemukan"

        Exit Sub

        Combo4.SetFocus

    End If

    'jika datanya ada maka saring data dalam laporan

    CR.SelectionFormula = "Month({Kas.Tanggal})=" & Val(Combo4.Text) & " and Year({Kas.Tanggal})=" & Val(Combo5.Text)

    'panggil file laporannya

    CR.ReportFileName = App.Path & "\Lap arus kas bulanan.rpt"

    CR.WindowState = crptMaximized

    CR.RetrieveDataFiles

    CR.Action = 1

End Sub

2.11.1 Laporan Arus Kas Harian

2.11.2 Laporan Arus Kas Mingguan

2.11.3 Laporan Arus Kas Bulanan

2.12            Laporan Biaya-Biaya

Koding :

Private Sub Form_Load()

Call BukaDB

Dim RS1 As New ADODB.Recordset

RS1.Open "select distinct perkiraan.kodeprk,perkiraan.namaprk from perkiraan,detailpo where perkiraan.kodeprk=detailpo.kodeprk", Conn

List1.Clear

Do While Not RS1.EOF

    List1.AddItem RS1!KodePrk & Space(3) & RS1!NamaPrk

    RS1.MoveNext

Loop

Dim RSTGL As New ADODB.Recordset

RSTGL.Open "select distinct tanggal from detailpo", Conn

Do While Not RSTGL.EOF

    Combo1.AddItem Format(RSTGL!Tanggal, "MM")

    RSTGL.MoveNext

Loop

Dim RSTHN As New ADODB.Recordset

RSTHN.Open "select distinct year(tanggal)  as sss from detailpo", Conn

Do While Not RSTHN.EOF

    Combo2.AddItem RSTHN!sss

    RSTHN.MoveNext

Loop

Conn.Close

End Sub

Private Sub List1_Click()

If Combo1 = "" Or Combo2 = "" Then

    MsgBox "Bulan dan Tahun tidak boleh kosong"

    Combo1.SetFocus

    Exit Sub

End If

Call BukaDB

Dim RS2 As New ADODB.Recordset

RS2.Open "select * from detailpo where month(tanggal)='" & Val(Combo1) & "' and year(tanggal)='" & (Combo2) & "' and kodeprk='" & Left(List1, 3) & "'", Conn

If RS2.EOF Then

    MsgBox "Data tidak ditemukan"

    Combo1.SetFocus

    Exit Sub

Else

    If Left(List1, 3) = "401" Then

        CR.SelectionFormula = "{Detailpo.Kodeprk}='" & Left(List1, 3) & "' and Month({detailPO.tanggal})=" & Val(Combo1.Text) & " and Year({Detailpo.Tanggal})=" & Val(Combo2.Text)

        CR.ReportFileName = App.Path & "\Lap oprs kendaraan.rpt"

        CR.WindowState = crptMaximized

        CR.RetrieveDataFiles

        CR.Action = 1

    Else

        CR.SelectionFormula = "{Detailpo.Kodeprk}='" & Left(List1, 3) & "' and Month({detailPO.tanggal})=" & Val(Combo1.Text) & " and Year({Detailpo.Tanggal})=" & Val(Combo2.Text)

        CR.ReportFileName = App.Path & "\Lap umum.rpt"

        CR.WindowState = crptMaximized

        CR.RetrieveDataFiles

        CR.Action = 1

    End If

End If

End Sub

2.12.1 Laporan Buku Besar

pada kesempatan kali ini saya akan menunjukkan aplikasi work order atau pemesanan barang, asumsi dalam aplikasi ini adalah sebuah usaha bengkel bubut yang sering membuat (misal) pagar teralis, jendela, pintu dan lain-lain.
aplikasi ini dibuat dengan vb 6 dan database access 2003. anda bisa mengembangkannya dengan tools lain. proses dalam aplikasi ini adalah sebagai berikut :
1. entri data user
2. entri data barang
3. entri data perkiraan
4. entri data pemesanan barang
5. entri data pengiriman barang
6. proses pelaporan

program aplikasi ujian online vb 6

Aplikasi Ujian ONLINE VB 6.0

5.6  Membuat Aplikasi Dengan Database MySql

 

Pada bab ini akan dibahas tentang sebuah aplikasi sederhana tentang PSB (Penerimaan Siswa Baru). Fokus pembahasan adalah pada soal ujian bagi para calon siswa dimana ujian saringan dilakukan dengan menjawab soal-soal dalam bentuk aplikasi (Ujian digital). Untuk memulainya ikutilah langkah-langkah di bawah ini.

5.6.1   Membuat Database Dan Tabel

1.              Aktifkan wamp server

2.              Aktifkan phpmyadmin

3.              Buatlah database dengan nama DBPSB (Ciptakan)

4.              Buatlah beberapa tabel dengan struktur sebagai berikut

 

Koding :

Dim Dijawab, status As String

Private Sub Form_Activate()

Call KoneksI

ADO.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "\DBUjian.mdb"

ADO.RecordSource = "tEMPORER"

ADO.Refresh

Set DG.DataSource = ADO

DG.Refresh

End Sub

Private Sub Form_Load()

Call KoneksI

Dim RSCari As New ADODB.Recordset

RSCari.Open "select distinct soal.idkuliah from soal,mata_kuliah where soal.idkuliah=mata_kuliah.idkuliah", Conn

If Not RSCari.EOF Then

    Combo5.Clear

    Do While Not RSCari.EOF

        Combo5.AddItem RSCari!idkuliah

        RSCari.MoveNext

    Loop

End If

Call Blank

Text1 = ""

LblTanggal = Date

Timer3.Enabled = False

AwalOpsi

End Sub

Sub Blank()

Call KoneksI

Dim hapustemporer As String

hapustemporer = "delete * from temporer"

Conn.Execute hapustemporer

Form_Activate

ADO.Refresh

DG.Refresh

End Sub

Private Sub Combo1_Click()

Call AwalOpsi

Text1 = ""

Call KoneksI

RSHasil.Open "select * from hasilujian where nim='" & Menu.STBar.Panels(1) & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSHasil.EOF Then

    MsgBox "anda pernah mengikui ujian mata kuliah ini, pilih mata kuliah lain"

    Combo5.SetFocus

    Exit Sub

End If

RSSoal.Open "select nomor,matakuliah from soal,mata_kuliah where soal.idkuliah=mata_kuliah.idkuliah and soal.idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblMataKuliah = RSSoal!Matakuliah

    List5.Clear

    Do While Not RSSoal.EOF

        List5.AddItem RSSoal!nomor

        RSSoal.MoveNext

    Loop

Else

    List5.Clear

    MsgBox "Soal belum dientri atau tidak terdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Command1_Click()

On Error Resume Next

If Combo1 = "" Then

    MsgBox "Anda belum memilih mata kuliah"

    Combo5.SetFocus

    Exit Sub

ElseIf List1 = "" Then

    MsgBox "anda belum memilih nomor soal"

    List5.SetFocus

    Exit Sub

ElseIf Text1 = "" Then

    MsgBox "anda belum memilih nomor soal"

    List5.SetFocus

    Exit Sub

ElseIf Option5.Value = False And Option2.Value = False And Option3.Value = False And Option4.Value = False Then

    MsgBox "anda belum melilih jawaban"

    Exit Sub

End If

Call KoneksI

RSTemporer.Open "select * from temporer where nomor='" & List1 & "'", Conn

If Not RSTemporer.EOF Then

    MsgBox "nomor ini sudah dijawab"

    List5.SetFocus

    Exit Sub

End If

Dim simpan As String

simpan = "insert into temporer(nomor,dijawab,jawaban,keterangan) values " & _

"('" & List1 & "','" & LblDijawab & "','" & LblJawaban & "','" & LblKet & "')"

Conn.Execute simpan

Form_Activate

List5.ListIndex = List5.ListIndex + 1

End Sub

Private Sub Command2_Click()

Timer2.Enabled = False

LblTotalSoal = List5.ListCount

Call TTLSoalDijawab

Call TTLbenar

Call TTLSALAH

LblDurasi = Format(CDate(LblSelesai.Caption) - CDate(LblMulai.Caption), "hh:mm:ss")

If LblBenar > LblSalah Then

    LblKeterangan = "LULUS"

Else

    LblKeterangan = "GAGAL"

End If

Timer3.Enabled = True

If Menu.STBar.Panels(3) = "ADMINISTRATOR" Then

MsgBox "Data ujian admin tidak perlu disimpan" & Chr(13) & _

        "Cukup untuk percobaan saja"

    Exit Sub

End If

Call KoneksI

Dim simpan1 As String

simpan1 = "insert into hasilujian(Nim,IDKULIAH,tanggal,mulai,selesai,durasi,jmlsoal,dijawab,benar,salah,keterangan) values " & _

"('" & Menu.STBar.Panels(1) & "','" & Combo1 & "','" & LblTanggal & "','" & LblMulai & "','" & LblSelesai & "','" & LblDurasi & "','" & LblTotalSoal & "','" & LblSoalDijawab & "','" & LblBenar & "','" & LblSalah & "','" & LblKeterangan & "')"

Conn.Execute simpan1

ADO.Recordset.MoveFirst

Do While Not ADO.Recordset.EOF

    Dim simpan2 As String

    simpan2 = "insert into detail(Nim,IDKULIAH,NOMOR,DIJAWAB,JAWABAN,KETERANGAN) values " & _

    "('" & Menu.STBar.Panels(1) & "','" & Combo1 & "','" & ADO.Recordset!nomor & "','" & ADO.Recordset!Dijawab & "','" & ADO.Recordset!jawaban & "','" & ADO.Recordset!keterangan & "')"

    Conn.Execute simpan2

    ADO.Recordset.MoveNext

Loop

End Sub

Private Sub Command3_Click()

Unload Me

End Sub

Private Sub Command4_Click()

MsgBox "5. Pilih Materi di combo paling atas" & Chr(13) & _

        "2. Pilih Nomor Soal dalam list di kiri" & Chr(13) & _

        "3. Pilih Jawaban pada option button" & vbCrLf & _

        "4. Klik Jawab" & vbCrLf & _

        "5. Lanjutkan ke Nomor Berikutnya"

End Sub

Private Sub List1_Click()

Call AwalOpsi

Call KoneksI

RSTemporer.Open "SELECT * FROM TEMPORER WHERE Nomor='" & List1 & "'", Conn

If Not RSTemporer.EOF Then

    MsgBox "Soal ini sudah dijawab"

    List5.SetFocus

Else

    RSSoal.Open "SELECT pertanyaan,a,b,c,d,jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

    If Not RSSoal.EOF Then

        Text1 = RSSoal!pertanyaan

        Option5.Caption = RSSoal!A

        Option2.Caption = RSSoal!B

        Option3.Caption = RSSoal!c

        Option4.Caption = RSSoal!d

        Label19 = RSSoal!jawaban

    End If

End If

End Sub

Private Sub Option1_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "A"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option2_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "B"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option3_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "C"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Option4_Click()

Call KoneksI

RSSoal.Open "SELECT jawaban FROM SOAL WHERE nomor='" & List1 & "' and idkuliah='" & Combo1 & "'", Conn

If Not RSSoal.EOF Then

    LblDijawab = "D"

    LblJawaban = RSSoal!jawaban

    If LblDijawab = LblJawaban Then LblKet = "BENAR" Else LblKet = "SALAH"

End If

End Sub

Private Sub Timer1_Timer()

LblMulai = Time$

Timer5.Enabled = False

End Sub

Private Sub Timer2_Timer()

LblSelesai = Time$

End Sub

Sub TTLSoalDijawab()

Call KoneksI

RSTemporer.Open "select count(*) as TOTALSOAL from temporer", Conn

LblSoalDijawab = RSTemporer!TOTALSOAL

End Sub

Sub TTLSoal()

Call KoneksI

RSTemporer.Open "select count(*) as aaa from temporer", Conn

LblTotalSoal = RSTemporer!aaa

'LblSoalDijawab = List5.ListCount

End Sub

Sub TTLbenar()

Call KoneksI

RSTemporer.Open "select count(keterangan) as aaa from temporer where keterangan='BENAR'", Conn

LblBenar = RSTemporer!aaa

End Sub

Sub TTLSALAH()

Call KoneksI

RSTemporer.Open "select count(keterangan) as aaa from temporer where keterangan='SALAH'", Conn

LblSalah = RSTemporer!aaa

End Sub

Private Sub Timer3_Timer()

If LblKeterangan.Visible = True Then

    LblKeterangan.Visible = False

ElseIf LblKeterangan.Visible = False Then

    LblKeterangan.Visible = True

End If

End Sub

Sub AwalOpsi()

Option5.Value = False

Option2.Value = False

Option3.Value = False

Option4.Value = False

Option5.Caption = "Jawaban A"

Option2.Caption = "Jawaban B"

Option3.Caption = "Jawaban C"

Option4.Caption = "Jawaban D"

End Sub

5.6.7   Membuat Form Laporan

Koding :

Private Sub Form_Load()

Call KoneksI

RSHasil.Open "select distinct nim,idkuliah from hasilujian", Conn

Combo5.Clear

Do While Not RSHasil.EOF

    Combo5.AddItem RSHasil!nim

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct idkuliah from hasilujian", Conn

Combo2.Clear

Combo4.Clear

Combo6.Clear

Do While Not RSHasil.EOF

    Combo2.AddItem RSHasil!idkuliah

    Combo4.AddItem RSHasil!idkuliah

    Combo6.AddItem RSHasil!idkuliah

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct kelas from mata_kuliah,siswa,hasilujian where hasilujian.nim=siswa.nim and mata_kuliah.idkuliah=hasilujian.idkuliah", Conn

Combo3.Clear

Combo5.Clear

Do While Not RSHasil.EOF

    Combo3.AddItem RSHasil!kelas

    Combo5.AddItem RSHasil!kelas

    RSHasil.MoveNext

Loop

Conn.Close

Call KoneksI

RSHasil.Open "select distinct keterangan from hasilujian", Conn

Combo7.Clear

Do While Not RSHasil.EOF

    Combo7.AddItem RSHasil!keterangan

    RSHasil.MoveNext

Loop

Conn.Close

End Sub

Private Sub Combo1_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where nim='" & Combo1 & "'", Conn

If Not RSSiswa.EOF Then

    LblNamamhs = RSSiswa!nama

Else

    MsgBox "nim tidak terfdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Combo2_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo2 & "'", Conn

If Not RSKuliah.EOF Then

    Lblmatakuliah = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo2.SetFocus

End If

End Sub

Private Sub Combo3_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where kelas='" & Combo3 & "'", Conn

If Not RSSiswa.EOF Then

    LblJurusan = RSSiswa!jurusan

Else

    MsgBox "kelas tidak terfdaftar"

    Combo3.SetFocus

End If

End Sub

Private Sub Combo4_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo4 & "'", Conn

If Not RSKuliah.EOF Then

    Lblkuliah1 = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo2.SetFocus

End If

End Sub

Private Sub Combo5_Click()

Call KoneksI

RSSiswa.Open "select * from siswa where kelas='" & Combo5 & "'", Conn

If Not RSSiswa.EOF Then

    Lbljurusan1 = RSSiswa!jurusan

Else

    MsgBox "kelas tidak terfdaftar"

    Combo5.SetFocus

End If

End Sub

Private Sub Combo6_Click()

Call KoneksI

RSKuliah.Open "select * from mata_kuliah where idkuliah='" & Combo6 & "'", Conn

If Not RSKuliah.EOF Then

    Lblkuliah2 = RSKuliah!Matakuliah

Else

    MsgBox "id mata kuliah tidak terfdaftar"

    Combo6.SetFocus

End If

End Sub

Private Sub Command1_Click()

If Combo1 = "" Or Combo2 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.nim})='" & Combo1 & "' and ({mata_kuliah.idkuliah})='" & Combo2 & "'"

CR.ReportFileName = App.Path & "\lap ujian5.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub

Private Sub Command2_Click()

If Combo3 = "" Or Combo4 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.kelas})='" & Combo3 & "' and ({mata_kuliah.idkuliah})='" & Combo4 & "'"

CR.ReportFileName = App.Path & "\lap per kelas.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub

Private Sub Command3_Click()

If Combo5 = "" Or Combo6 = "" Or Combo7 = "" Then

    MsgBox "Data tidak lengkap"

    Exit Sub

End If

CR.SelectionFormula = "({siswa.kelas})='" & Combo5 & "' and ({mata_kuliah.idkuliah})='" & Combo6 & "' and ({hasilujian.keterangan})='" & Combo7 & "'"

CR.ReportFileName = App.Path & "\lap per kelas.rpt"

CR.WindowState = crptMaximized

CR.RetrieveDataFiles

CR.Action = 1

CR.Reset

End Sub