Tuesday 3 July 2012
Sunday 24 June 2012
Code Program VB [PERPUSTAKAAN] menggunakan true data grid dan Crystal Report
Dim konek As String
Dim kon As New ADODB.Connection
Dim rkp, pg, rsem, rmhs, rs, rmt, rdel, kem, rkem, rsim, rp, cek, rcek, rg, rh As Recordset
Dim kg, jk As String
Private Sub Command4_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from sem", kon, adOpenKeyset, adLockReadOnly
rsim.MoveFirst
While rsim.EOF = False
Set rs = New ADODB.Recordset
rs.Open "select * from pinjam", kon, adOpenKeyset, adLockBatchOptimistic
rs.AddNew
rs!kodepinjam = kp
rs!tglpinjam = rsim!tglpinjam
rs!tglpengembalian = rsim!tglpengembalian
rs!kodeanggota = kd
rs!namaanggota = nama
rs!kodebuku = rsim!kodebuku
rs!judul = rsim!judul
rs.UpdateBatch adAffectAllChapters
rsim.MoveNext
Wend
Command6_click
Form_Load
dg.Refresh
End Sub
Private Sub Command7_Click()
Set rkem = New ADODB.Recordset
rkem.Open "select * from pinjam where kodepinjam = '" & Trim(kp) & "'", kon, adOpenKeyset, adLockReadOnly
rkem.MoveFirst
While rkem.EOF = False
Set kem = New ADODB.Recordset
kem.Open "select * from kembali", kon, adOpenKeyset, adLockBatchOptimistic
kem.AddNew
kem!kodekembali = Text4
kem!kodepinjam = kp
kem!kodeanggota = kd
kem!namaanggota = nama
kem!kodebuku = rkem!kodebuku
kem!judul = rkem!judul
kem!tglpinjam = rkem!tglpinjam
kem!tglpengembalian = rkem!tglpengembalian
kem!denda = Val(Text1)
kem!tgldikembalikan = Text2
kem.UpdateBatch adAffectAllChapters
rkem.MoveNext
Wend
Command6_click
Form_Load
dg.Refresh
End Sub
Private Sub Command8_Click()
crp.ReportFileName = (App.Path & "\rpinjam.rpt")
crp.SelectionFormula = "{pinjam.kodepinjam} = '" & Trim(kp) & "'"
crp.RetrieveDataFiles
crp.WindowState = crptMaximized
crp.Action = 1
End Sub
Private Sub Command9_Click()
crp.ReportFileName = (App.Path & "\rkembali.rpt")
crp.SelectionFormula = "{kembali.kodepinjam} = '" & Trim(kp) & "'"
crp.RetrieveDataFiles
crp.WindowState = crptMaximized
crp.Action = 1
End Sub
Private Sub Form_Load()
Frame1.Visible = False
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\STMIK 2011\SEMESTER 2\PEMROGRAMAN BASIS DATA 1\Tugas UAS\tugas.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Call hapus
Set rdel = New ADODB.Recordset
rdel.Open "select * from sem", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
dg.Columns(0).Width = 1000
dg.Columns(1).Width = 4800
dg.Columns(2).Width = 1200
dg.Columns(3).Width = 1500
Call ksg
End Sub
Private Sub kd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set cek = New ADODB.Recordset
cek.Open "select * from kembali where kodeanggota = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If cek.EOF = True Then
Set rcek = New ADODB.Recordset
rcek.Open "select * from pinjam where kodeanggota = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If rcek.EOF = False Then
MsgBox ("Anggota Tersebut Belum Mengembalikan Buku")
End If
End If
kd.SetFocus
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from anggota where kode = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
nama = rmhs!nama
dg.SetFocus
Else
MsgBox ("Kode Tersebut Tidak Ada")
kd = ""
kd.SetFocus
End If
End If
End Sub
Private Sub dg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If dg.Col = 0 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from buku where kodebuku = '" & Trim(dg.Columns.Item(0)) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
dg.Columns.Item(1) = rmt!judul
dg.Columns.Item(2) = Format(Now(), "dd/mm/yyyy")
For t = 1 To rdel.RecordCount
dg.Columns.Item(3) = Format(Now + (t * 7), "dd/mm/yyyy")
Next t
For a = 0 To dg.Row + 1
dg.Row = a
Next a
dg.Col = 0
Else
MsgBox ("buku tsb GAK ADA")
dg.Col = 0
End If
End If
End If
End Sub
Private Sub ksg()
kd = ""
nama = ""
Text2 = Format(Now, "dd/mm/yyyy")
Text1 = ""
End Sub
Private Sub Command1_click()
Frame1.Visible = True
Label3.Visible = False
Text4.Visible = False
Label4.Visible = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Label6.Visible = False
Label5.Visible = False
Text2.Visible = False
Text1.Visible = False
Command7.Visible = False
Line2.Visible = False
Line3.Visible = False
Command9.Visible = False
Command8.Visible = False
ksg
kd.SetFocus
otomat
End Sub
Private Sub Command2_click()
Frame1.Visible = True
Label3.Visible = True
Text4.Visible = True
Label4.Visible = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Label5.Visible = True
Text2.Visible = True
Label6.Visible = True
Text1.Visible = True
Command7.Visible = True
Line2.Visible = True
Line3.Visible = True
Command8.Visible = True
Command9.Visible = True
ksg
kp = ""
kp.SetFocus
otomat2
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command5_Click()
dg.MovePrevious
dg.SetFocus
End Sub
Private Sub Command6_click()
Frame1.Visible = False
Label4.Visible = True
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
End Sub
Private Sub otomat()
no = Val(Right(kp, 3)) + 1
If no < 10 Then
kp = "kp" & "00" & no
ElseIf no < 100 Then
kp = "kp" & "0" & no
ElseIf no < 1000 Then
kp = "kp" & no
End If
End Sub
Private Sub otomat2()
no = Val(Right(Text4, 3)) + 1
If no < 10 Then
Text4 = "kk" & "00" & no
ElseIf no < 100 Then
Text4 = "kk" & "0" & no
ElseIf no < 1000 Then
Text4 = "kk" & no
End If
End Sub
Private Sub hapus()
Set rsem = New ADODB.Recordset
rsem.Open "delete * from sem", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rsem
End Sub
Private Sub kp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rp = kon.Execute("select * from pinjam where kodepinjam like '%" & Trim(kp) & "%'")
dg.Refresh
Set dg.DataSource = rp
Set rc = New ADODB.Recordset
rc.Open "select * from pinjam where kodepinjam like '" & Trim(kp) & "'", kon, adOpenKeyset, adLockReadOnly
If rc.EOF = False Then
kd = rc!kodeanggota
nama = rc!namaanggota
dg.SetFocus
For a = 0 To dg.Row + 1
dg.Row = a
Next a
dg.Col = 3
If Val(Mid(Text2, 4, 2)) < Val(Mid(dg.Columns.Item(3), 4, 2)) Then
Text1 = "0"
Else
If Text2 > dg.Columns.Item(3) Then
z = Val(Text2) - Val(dg.Columns.Item(3))
Text1 = z * 200
End If
End If
Else
MsgBox ("data gak ada")
kp = ""
kp.SetFocus
End If
End If
End Sub
Dim kon As New ADODB.Connection
Dim rkp, pg, rsem, rmhs, rs, rmt, rdel, kem, rkem, rsim, rp, cek, rcek, rg, rh As Recordset
Dim kg, jk As String
Private Sub Command4_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from sem", kon, adOpenKeyset, adLockReadOnly
rsim.MoveFirst
While rsim.EOF = False
Set rs = New ADODB.Recordset
rs.Open "select * from pinjam", kon, adOpenKeyset, adLockBatchOptimistic
rs.AddNew
rs!kodepinjam = kp
rs!tglpinjam = rsim!tglpinjam
rs!tglpengembalian = rsim!tglpengembalian
rs!kodeanggota = kd
rs!namaanggota = nama
rs!kodebuku = rsim!kodebuku
rs!judul = rsim!judul
rs.UpdateBatch adAffectAllChapters
rsim.MoveNext
Wend
Command6_click
Form_Load
dg.Refresh
End Sub
Private Sub Command7_Click()
Set rkem = New ADODB.Recordset
rkem.Open "select * from pinjam where kodepinjam = '" & Trim(kp) & "'", kon, adOpenKeyset, adLockReadOnly
rkem.MoveFirst
While rkem.EOF = False
Set kem = New ADODB.Recordset
kem.Open "select * from kembali", kon, adOpenKeyset, adLockBatchOptimistic
kem.AddNew
kem!kodekembali = Text4
kem!kodepinjam = kp
kem!kodeanggota = kd
kem!namaanggota = nama
kem!kodebuku = rkem!kodebuku
kem!judul = rkem!judul
kem!tglpinjam = rkem!tglpinjam
kem!tglpengembalian = rkem!tglpengembalian
kem!denda = Val(Text1)
kem!tgldikembalikan = Text2
kem.UpdateBatch adAffectAllChapters
rkem.MoveNext
Wend
Command6_click
Form_Load
dg.Refresh
End Sub
Private Sub Command8_Click()
crp.ReportFileName = (App.Path & "\rpinjam.rpt")
crp.SelectionFormula = "{pinjam.kodepinjam} = '" & Trim(kp) & "'"
crp.RetrieveDataFiles
crp.WindowState = crptMaximized
crp.Action = 1
End Sub
Private Sub Command9_Click()
crp.ReportFileName = (App.Path & "\rkembali.rpt")
crp.SelectionFormula = "{kembali.kodepinjam} = '" & Trim(kp) & "'"
crp.RetrieveDataFiles
crp.WindowState = crptMaximized
crp.Action = 1
End Sub
Private Sub Form_Load()
Frame1.Visible = False
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\STMIK 2011\SEMESTER 2\PEMROGRAMAN BASIS DATA 1\Tugas UAS\tugas.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Call hapus
Set rdel = New ADODB.Recordset
rdel.Open "select * from sem", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
dg.Columns(0).Width = 1000
dg.Columns(1).Width = 4800
dg.Columns(2).Width = 1200
dg.Columns(3).Width = 1500
Call ksg
End Sub
Private Sub kd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set cek = New ADODB.Recordset
cek.Open "select * from kembali where kodeanggota = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If cek.EOF = True Then
Set rcek = New ADODB.Recordset
rcek.Open "select * from pinjam where kodeanggota = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If rcek.EOF = False Then
MsgBox ("Anggota Tersebut Belum Mengembalikan Buku")
End If
End If
kd.SetFocus
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from anggota where kode = '" & Trim(kd) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
nama = rmhs!nama
dg.SetFocus
Else
MsgBox ("Kode Tersebut Tidak Ada")
kd = ""
kd.SetFocus
End If
End If
End Sub
Private Sub dg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If dg.Col = 0 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from buku where kodebuku = '" & Trim(dg.Columns.Item(0)) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
dg.Columns.Item(1) = rmt!judul
dg.Columns.Item(2) = Format(Now(), "dd/mm/yyyy")
For t = 1 To rdel.RecordCount
dg.Columns.Item(3) = Format(Now + (t * 7), "dd/mm/yyyy")
Next t
For a = 0 To dg.Row + 1
dg.Row = a
Next a
dg.Col = 0
Else
MsgBox ("buku tsb GAK ADA")
dg.Col = 0
End If
End If
End If
End Sub
Private Sub ksg()
kd = ""
nama = ""
Text2 = Format(Now, "dd/mm/yyyy")
Text1 = ""
End Sub
Private Sub Command1_click()
Frame1.Visible = True
Label3.Visible = False
Text4.Visible = False
Label4.Visible = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Label6.Visible = False
Label5.Visible = False
Text2.Visible = False
Text1.Visible = False
Command7.Visible = False
Line2.Visible = False
Line3.Visible = False
Command9.Visible = False
Command8.Visible = False
ksg
kd.SetFocus
otomat
End Sub
Private Sub Command2_click()
Frame1.Visible = True
Label3.Visible = True
Text4.Visible = True
Label4.Visible = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Label5.Visible = True
Text2.Visible = True
Label6.Visible = True
Text1.Visible = True
Command7.Visible = True
Line2.Visible = True
Line3.Visible = True
Command8.Visible = True
Command9.Visible = True
ksg
kp = ""
kp.SetFocus
otomat2
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Command5_Click()
dg.MovePrevious
dg.SetFocus
End Sub
Private Sub Command6_click()
Frame1.Visible = False
Label4.Visible = True
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
End Sub
Private Sub otomat()
no = Val(Right(kp, 3)) + 1
If no < 10 Then
kp = "kp" & "00" & no
ElseIf no < 100 Then
kp = "kp" & "0" & no
ElseIf no < 1000 Then
kp = "kp" & no
End If
End Sub
Private Sub otomat2()
no = Val(Right(Text4, 3)) + 1
If no < 10 Then
Text4 = "kk" & "00" & no
ElseIf no < 100 Then
Text4 = "kk" & "0" & no
ElseIf no < 1000 Then
Text4 = "kk" & no
End If
End Sub
Private Sub hapus()
Set rsem = New ADODB.Recordset
rsem.Open "delete * from sem", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rsem
End Sub
Private Sub kp_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rp = kon.Execute("select * from pinjam where kodepinjam like '%" & Trim(kp) & "%'")
dg.Refresh
Set dg.DataSource = rp
Set rc = New ADODB.Recordset
rc.Open "select * from pinjam where kodepinjam like '" & Trim(kp) & "'", kon, adOpenKeyset, adLockReadOnly
If rc.EOF = False Then
kd = rc!kodeanggota
nama = rc!namaanggota
dg.SetFocus
For a = 0 To dg.Row + 1
dg.Row = a
Next a
dg.Col = 3
If Val(Mid(Text2, 4, 2)) < Val(Mid(dg.Columns.Item(3), 4, 2)) Then
Text1 = "0"
Else
If Text2 > dg.Columns.Item(3) Then
z = Val(Text2) - Val(dg.Columns.Item(3))
Text1 = z * 200
End If
End If
Else
MsgBox ("data gak ada")
kp = ""
kp.SetFocus
End If
End If
End Sub
Code Program VB SPP menggunakan true data grid
Dim kon As New ADODB.Connection
Dim rbyr, rsim, rs, rdel, rsem, rmhs, rspp, rb As Recordset
Dim bl As String
Private Sub Command1_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from bayar", kon, adOpenKeyset, adLockBatchOptimistic
For a = 1 To Val(Text6)
bl = Val(bl) + 1
If bl < 10 Then bl = "0" & Trim(Str(bl))
rsim.AddNew
rsim!nim = Text1
rsim!blth = bl & Format(tgl, "yy")
rsim!tglb = Format(Now(), Date)
rsim.UpdateBatch adAffectAllChapters
Next a
dg.DataSource = rsim
ksg
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\STMIK 2011\SEMESTER 2\PEMROGRAMAN BASIS DATA 1\spp\spp.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Set rdel = New ADODB.Recordset
rdel.Open "select * from bayar", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
ksg
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim b, t As String
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "Select * From mhs where nim = '" & Trim(Text1) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
Text2 = rmhs!nama
Set rspp = New ADODB.Recordset
rspp.Open "Select * From mspp where right(tahun,2) = '" & Mid(Text1, 2, 2) & "'", kon, adOpenKeyset, adLockReadOnly
Text3 = rspp!nominal & "00"
Set rb = New ADODB.Recordset
rb.Open "Select * From bayar where nim = '" & Trim(Text1) & "' order by blth desc", kon, adOpenKeyset, adLockReadOnly
If rb.RecordCount = 0 Then
Text4 = ""
bl = Format(tgl, "mm")
Else
bl = Left(rb!blth, 2)
t = Right(rb!blth, 2)
Text4 = "bulan " & bl & " tahun " & t
If bl = Format(tgl, "mm") And t = Format(tgl, "yy") Then
ket = "LUNAS"
ElseIf Val(bl) < Val(Format(tgl, "mm")) Then
Text5 = Val(Format(tgl, "mm")) - Val(bl)
ket = "kurang " & Text5 & " bulan"
Text6 = Text5
Text7 = Val(Text3) * Val(Text6)
ElseIf Val(t) < Val(Format(tgl, "yy")) Then
Text5 = 12 - Val(Format(tgl, "mm")) + Val(bl)
ket = "kurang " & Text5 & " bulan"
Text6 = Text5
Text7 = Val(Text3) * Val(Text6)
End If
End If
Text6.SetFocus
Else
MsgBox ("NIM tsb TIDAK ADA, ULANGI !!!")
Text1 = ""
Text1.SetFocus
End If
ElseIf Val(Text6) > Val(Text5) Then
Text7 = Val(Text3) * Val(Text6)
End If
End Sub
Private Sub ksg()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
ket = ""
tgl = Format(Now(), ddmmyyyy)
dg.Columns(0).Width = 1500
dg.Columns(1).Width = 1200
dg.Columns(2).Width = 2000
End Sub
Dim rbyr, rsim, rs, rdel, rsem, rmhs, rspp, rb As Recordset
Dim bl As String
Private Sub Command1_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from bayar", kon, adOpenKeyset, adLockBatchOptimistic
For a = 1 To Val(Text6)
bl = Val(bl) + 1
If bl < 10 Then bl = "0" & Trim(Str(bl))
rsim.AddNew
rsim!nim = Text1
rsim!blth = bl & Format(tgl, "yy")
rsim!tglb = Format(Now(), Date)
rsim.UpdateBatch adAffectAllChapters
Next a
dg.DataSource = rsim
ksg
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\STMIK 2011\SEMESTER 2\PEMROGRAMAN BASIS DATA 1\spp\spp.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Set rdel = New ADODB.Recordset
rdel.Open "select * from bayar", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
ksg
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim b, t As String
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "Select * From mhs where nim = '" & Trim(Text1) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
Text2 = rmhs!nama
Set rspp = New ADODB.Recordset
rspp.Open "Select * From mspp where right(tahun,2) = '" & Mid(Text1, 2, 2) & "'", kon, adOpenKeyset, adLockReadOnly
Text3 = rspp!nominal & "00"
Set rb = New ADODB.Recordset
rb.Open "Select * From bayar where nim = '" & Trim(Text1) & "' order by blth desc", kon, adOpenKeyset, adLockReadOnly
If rb.RecordCount = 0 Then
Text4 = ""
bl = Format(tgl, "mm")
Else
bl = Left(rb!blth, 2)
t = Right(rb!blth, 2)
Text4 = "bulan " & bl & " tahun " & t
If bl = Format(tgl, "mm") And t = Format(tgl, "yy") Then
ket = "LUNAS"
ElseIf Val(bl) < Val(Format(tgl, "mm")) Then
Text5 = Val(Format(tgl, "mm")) - Val(bl)
ket = "kurang " & Text5 & " bulan"
Text6 = Text5
Text7 = Val(Text3) * Val(Text6)
ElseIf Val(t) < Val(Format(tgl, "yy")) Then
Text5 = 12 - Val(Format(tgl, "mm")) + Val(bl)
ket = "kurang " & Text5 & " bulan"
Text6 = Text5
Text7 = Val(Text3) * Val(Text6)
End If
End If
Text6.SetFocus
Else
MsgBox ("NIM tsb TIDAK ADA, ULANGI !!!")
Text1 = ""
Text1.SetFocus
End If
ElseIf Val(Text6) > Val(Text5) Then
Text7 = Val(Text3) * Val(Text6)
End If
End Sub
Private Sub ksg()
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
ket = ""
tgl = Format(Now(), ddmmyyyy)
dg.Columns(0).Width = 1500
dg.Columns(1).Width = 1200
dg.Columns(2).Width = 2000
End Sub
Monday 28 May 2012
Code Program VB KRS mahasiswa menggunakan true data grid
Dim konek As String
Dim kon As New ADODB.Connection
Dim rsim, rs, rdel, rsem, rmhs, rmt As Recordset
Dim kg, jk As String
Private Sub Command1_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from sem", kon, adOpenKeyset, adLockReadOnly
rsim.MoveFirst
While rsim.EOF = False
Set rs = New ADODB.Recordset
rs.Open "select * from KRS", kon, adOpenKeyset, adLockBatchOptimistic
rs.AddNew
rs!thakd = ta
rs!nim = nim
rs!kdmk = rsim!kode
rs!nilai = 0
rs.UpdateBatch adAffectAllChapters
rsim.MoveNext
Wend
Form_Load
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mhs.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
hapus
Set rdel = New ADODB.Recordset
rdel.Open "select * from sem", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
dg.Columns(0).Width = 1000
dg.Columns(1).Width = 5800
dg.Columns(2).Width = 700
dg.Columns(2).Alignment = 1
ksg
End Sub
Private Sub nim_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from mahasiswa where nim = '" & Trim(nim) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
nama = rmhs!nama
dg.SetFocus
Else
MsgBox ("nim tsb gak ada")
nim = ""
nim.SetFocus
End If
End If
End Sub
Private Sub dg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If dg.Col = 0 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from mata where kode = '" & Trim(dg.Columns.Item(0)) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
dg.Columns.Item(1) = rmt!nama
dg.Columns.Item(2) = rmt!sks
jsks = Val(jsks) + rmt!sks
dg.Col = 2
Else
MsgBox ("Kode Matakuliah tsb GAK ADA")
dg.Col = 0
End If
ElseIf dg.Col = 2 Then
jsks = Val(dg.Columns.Item(2)) * Val(dg.Columns.Item(0))
End If
End If
End Sub
Private Sub ksg()
ta = "2012"
nim = ""
nama = ""
kd = ""
nkd = ""
sks = ""
jsks = ""
End Sub
Private Sub hapus()
Set rsem = New ADODB.Recordset
rsem.Open "delete * from sem", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rsem
End Sub
Dim kon As New ADODB.Connection
Dim rsim, rs, rdel, rsem, rmhs, rmt As Recordset
Dim kg, jk As String
Private Sub Command1_Click()
Set rsim = New ADODB.Recordset
rsim.Open "select * from sem", kon, adOpenKeyset, adLockReadOnly
rsim.MoveFirst
While rsim.EOF = False
Set rs = New ADODB.Recordset
rs.Open "select * from KRS", kon, adOpenKeyset, adLockBatchOptimistic
rs.AddNew
rs!thakd = ta
rs!nim = nim
rs!kdmk = rsim!kode
rs!nilai = 0
rs.UpdateBatch adAffectAllChapters
rsim.MoveNext
Wend
Form_Load
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\mhs.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
hapus
Set rdel = New ADODB.Recordset
rdel.Open "select * from sem", kon, adOpenDynamic, adLockOptimistic
Set dg.DataSource = rdel
dg.Columns(0).Width = 1000
dg.Columns(1).Width = 5800
dg.Columns(2).Width = 700
dg.Columns(2).Alignment = 1
ksg
End Sub
Private Sub nim_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from mahasiswa where nim = '" & Trim(nim) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
nama = rmhs!nama
dg.SetFocus
Else
MsgBox ("nim tsb gak ada")
nim = ""
nim.SetFocus
End If
End If
End Sub
Private Sub dg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
If dg.Col = 0 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from mata where kode = '" & Trim(dg.Columns.Item(0)) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
dg.Columns.Item(1) = rmt!nama
dg.Columns.Item(2) = rmt!sks
jsks = Val(jsks) + rmt!sks
dg.Col = 2
Else
MsgBox ("Kode Matakuliah tsb GAK ADA")
dg.Col = 0
End If
ElseIf dg.Col = 2 Then
jsks = Val(dg.Columns.Item(2)) * Val(dg.Columns.Item(0))
End If
End If
End Sub
Private Sub ksg()
ta = "2012"
nim = ""
nama = ""
kd = ""
nkd = ""
sks = ""
jsks = ""
End Sub
Private Sub hapus()
Set rsem = New ADODB.Recordset
rsem.Open "delete * from sem", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rsem
End Sub
Tuesday 15 May 2012
Code Program VB [KRS Mahasiswa]
Dim konek As String
Dim kon As New ADODB.Connection
Dim rdel, rsem, rmhs, rmt As Recordset
Dim kg, jk As String
Private Sub Command2_Click()
Set rsem = New ADODB.Recordset
rsem.Open "select * from sem", kon, adOpenKeyset, adLockBatchOptimistic
rsem.AddNew
rsem!kode = tkd
rsem!nama = tma
rsem!sks = tsks
rsem.UpdateBatch adAffectAllChapters
End Sub
Private Sub tkd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from mata where kode = '" & Trim(tkd) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
tma = rmt!nama
tsks = rmt!sks
Command2.SetFocus
Else
MsgBox ("Kode Matakuliah tsb GAK ADA")
tkd = ""
tkd.SetFocus
End If
End If
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\kul.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Set rdel = New ADODB.Recordset
rdel.Open "delete from sem", kon, adOpenKeyset, adLockBatchOptimistic
ksg
End Sub
Private Sub ksg()
tak = Format(Now(), "yyyy") & "1"
tnim = ""
tnm = ""
tkd = ""
tma = ""
tsks = ""
jsks = ""
End Sub
Private Sub tnim_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from mhs where nim = '" & Trim(tnim) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
tnm = rmhs!nama
tkd.SetFocus
Else
MsgBox ("NIM tsb GAK ADA")
tnim = ""
tnim.SetFocus
End If
End If
End Sub
Dim kon As New ADODB.Connection
Dim rdel, rsem, rmhs, rmt As Recordset
Dim kg, jk As String
Private Sub Command2_Click()
Set rsem = New ADODB.Recordset
rsem.Open "select * from sem", kon, adOpenKeyset, adLockBatchOptimistic
rsem.AddNew
rsem!kode = tkd
rsem!nama = tma
rsem!sks = tsks
rsem.UpdateBatch adAffectAllChapters
End Sub
Private Sub tkd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmt = New ADODB.Recordset
rmt.Open "select * from mata where kode = '" & Trim(tkd) & "'", kon, adOpenKeyset, adLockReadOnly
If rmt.EOF = False Then
tma = rmt!nama
tsks = rmt!sks
Command2.SetFocus
Else
MsgBox ("Kode Matakuliah tsb GAK ADA")
tkd = ""
tkd.SetFocus
End If
End If
End Sub
Private Sub Form_Load()
konek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\kul.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open konek
kon.CursorLocation = adUseClient
Set rdel = New ADODB.Recordset
rdel.Open "delete from sem", kon, adOpenKeyset, adLockBatchOptimistic
ksg
End Sub
Private Sub ksg()
tak = Format(Now(), "yyyy") & "1"
tnim = ""
tnm = ""
tkd = ""
tma = ""
tsks = ""
jsks = ""
End Sub
Private Sub tnim_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Set rmhs = New ADODB.Recordset
rmhs.Open "select * from mhs where nim = '" & Trim(tnim) & "'", kon, adOpenKeyset, adLockReadOnly
If rmhs.EOF = False Then
tnm = rmhs!nama
tkd.SetFocus
Else
MsgBox ("NIM tsb GAK ADA")
tnim = ""
tnim.SetFocus
End If
End If
End Sub
Subscribe to:
Posts (Atom)