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

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

Cara Install Visual Basic 6.0 di Windows 7

Cara Install Visual Basic 6.0 di Windows 7

1. Cari file setup.exe pada master setup vb6
2. Klikkanan setup.exe danpilih Properties
3.Atur Properties File setup.exe sepertigambar di bawahini :

Lalutekantombol OK 

4. Double click file setup.exe, Klik Run Program (lihatgambar di bawahini):
 

MENGINSTALL VISUAL BASIC 6.0 DI WINDOWS 7 ULTIMATE

Posted: 17 Mei 2010 in Tutorial

10

1.        Pada folder VB 6à Setup.exe nya di klikkananpilih properties..

 

1.        KemudianpilihCompability..

 

1.        Setelahsetinganberikutdisesuaikan, klik OK..

 

1.        Kemudiankembalike Folder VB tadipilih Sub Folder VB98 à kikkananpilih properties .., danikutisepertigambar di bawah..

 

1.        KemudianLakukanpenginstalansepertibiasa, danjikaperingatanberikutmunculpilih Run Program ya..

 

1.        Setelahselesai, cobabuka VB nyadengancarasepertiGambar di bawah ..

 

Semogamembantu..:)

Program Visual Basic [NIP PENDUDUK]

Dim sambung, j As String
Dim kon As New ADODB.Connection


Private Sub Command1_Click()
Set kos = New ADODB.Recordset
kos.Open "penduduk", kon, adOpenKeyset, adLockBatchOptimistic
kos.AddNew
kos!nama = nm
kos!nip = nip
kos.UpdateBatch adAffectAllChapters
Set dg.DataSource = kos
End Sub


Private Sub Form_Load()
sambung = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\penduduk.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open sambung
kon.CursorLocation = adUseClient
Set rpen = New ADODB.Recordset
rpen.Open "penduduk", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rpen
nm = ""
tgl = Format(Now(), ddmmyy)
kota = "PILIH DISINI"
nip = ""
End Sub


Private Sub kota_lostfocus()
otomat
End Sub


Private Sub tgl_lostfocus()
otomat
End Sub


Private Sub otomat()
kd = Trim(Str(kota.ListIndex)) & Trim(Format(tglh, "ddmmyy"))
Set rg = New ADODB.Recordset
rg.Open "select * from penduduk where left(nip,7)='" & Trim(kd) & "'", kon, adOpenKeyset
If rg.RecordCount = 0 Then
nip = kd & "01"
Else
rg.MoveLast
no = Val(Right(rg!nip, 2)) + 1
If no < 10 Then
nip = kd & "0" & Trim(Str(no))
Else
nip = kd & Trim(Str(no))
End If
End If
Set dg.DataSource = rg
End Sub

Code Program VB [NIM mahasiswa]

Dim sambung, j As String
Dim kon As New ADODB.Connection
Dim vnim As New ADODB.Recordset


Private Sub Command1_Click()
Set rsim = New ADODB.Recordset
rsim.Open "formulir", kon, adOpenKeyset, adLockBatchOptimistic
rsim.AddNew
rsim!progdi = ps.ListIndex + 1
rsim!nim = tnim
rsim!nama = nama
rsim!tgllhr = tl
If op.Value = True Then
rsim!jk = 1
Else
rsim!jk = 0
End If
rsim!agama = agm.ListIndex + 1
rsim!alamat = alm
rsim!hp = hp
rsim.UpdateBatch adAffectAllChapters
Set dg.DataSource = rsim
End Sub


Private Sub Form_Load()
sambung = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\tgs.mdb;Persist Security Info=False"
Set kon = New ADODB.Connection
kon.Open sambung
kon.CursorLocation = adUseClient
Set rfor = New ADODB.Recordset
rfor.Open "formulir", kon, adOpenKeyset, adLockBatchOptimistic
Set dg.DataSource = rfor
ps.ListIndex = 0
tnim = ""
nama = ""
agm.ListIndex = 0
alm = ""
hp = ""
Label2.Caption = Format(Now(), "dddd, dd mmmm yyyy")
End Sub


Private Sub ps_LostFocus()
n = 1
If ps.ListIndex = 1 Then
 j = "2"
ElseIf ps.ListIndex = 2 Then
 j = "3"
Else
 j = "1"
End If
Set rfor = kon.Execute("select * from formulir where mid(nim,5,1)='" & j & "'")
If rfor.RecordCount = 0 Then
tnim = "2" & Format(Now(), "yy") & "7" & j & "0000" & n
Else
   rfor.MoveLast
n = Val(Right(rfor!nim, 5)) + 1
If n < 10 Then
  tnim = "2" & Format(Now(), "yy") & "7" & j & "0000" & n & ""
ElseIf n < 100 Then
  tnim = "2" & Format(Now(), "yy") & "7" & j & "000" & n & ""
ElseIf n < 1000 Then
  tnim = "2" & Format(Now(), "yy") & "7" & j & "00" & n & ""
Else
tnim = "2" & Format(Now(), "yy") & "7" & j & "0" & n & ""
End If
End If
End Sub