Membuat AutoNumber di Visual Basic 6.0

Membuat AutoNumber di Visual Basic 6.0, pada postingan kali ini saya akan membahas tentang cara membuat AutoNumber pada project yang dibuat, yaitu project input mahasiswa baru sebagai contoh didalam penerapan sesuai pada judul diatas, hal ini memberi manfaat agar mempermudah memberikan penomoran secara otomatis.

dalam pembuatannya anda harus membuat databasenya dahulu, di bawah ini adalah database sederhana silahkan anda buat databasenya seperti di bawah ini :

Buatlah database dengan nama DB_MHS.mdb, lalu buat tables dengan nama MHS, struktur table sebagai berikut :

Selanjutnya, buatlah rancangan form seperti dibawah ini :

Pengaturan pengisian property secara langsung sebagai berikut :

Untuk Listing Programnya sebagai berikut : 

Private Sub AutoNumber()
' Prosedure membuat nomor otomatis
Call Buka
RsMhs.Open ("SELECT * FROM mhs WHERE nim in(select max(nim) from mhs)order by nim desc"), Conn
RsMhs.Requery
    Dim Urut As String * 5
    Dim Hitung As Long
    With RsMhs
        If .EOF Then
            Urut = "00001"
            TxtNim = Urut
        Else
            Hitung = Right(!nim, 5) + 1
            Urut = Right("0000" & Hitung, 5)
        End If
        TxtNim = Urut
    End With
End Sub

Private Sub CmdNew_Click()
    '' //Memanggil prosedure penomoran otomatis
    AutoNumber
    TxtNama.Enabled = True
    TxtAlamat.Enabled = True
    TxtJurusan.Enabled = True

    CmdNew.Enabled = False
    CmdSave.Enabled = True
    
    TxtNama.SetFocus
End Sub

Private Sub CmdSave_Click()
If TxtNama = "" Or TxtAlamat = "" Or TxtJurusan = "" Then
    MsgBox "Ada Data Yang Belum Diisi...!," & vbCrLf & "" _
           & "Mohon Data Dilengkapi Dulu", vbCritical, "Peringatan"
    Exit Sub
Else
    Dim SqlAdd As String
    SqlAdd = "INSERT INTO mhs(nim,nama,alamat,jurusan)values" _
              & "('" & TxtNim & "','" & TxtNama & "','" & TxtAlamat & "','" & TxtJurusan & "')"
    Conn.Execute (SqlAdd)
End If

Form_Activate
TxtNim = ""
TxtNama = ""
TxtAlamat = ""
TxtJurusan = ""
TxtNama.Enabled = False
TxtAlamat.Enabled = False
TxtJurusan.Enabled = False
CmdSave.Enabled = False
CmdNew.Enabled = True
End Sub

Private Sub CmdExit_Click()
Unload Me
End Sub

Private Sub Form_Activate()
Buka
Conn.CursorLocation = adUseClient
MSFlexGrid1.Refresh
TampilGrid
End Sub

Private Sub Form_Load()
TxtNim = ""
TxtNama = ""
TxtAlamat = ""
TxtJurusan = ""
TxtNim.Enabled = False
TxtNama.Enabled = False
TxtAlamat.Enabled = False
TxtJurusan.Enabled = False

CmdSave.Enabled = False
End Sub

Sub AktifGrid()
With MSFlexGrid1
    .Cols = 5
    .RowHeightMin = 300
        
    .Col = 0
    .Row = 0
    .Text = "NO"
    .CellFontBold = True
    .ColWidth(0) = 400
    .AllowUserResizing = flexResizeColumns
    .CellAlignment = flexAlignCenterCenter
      
    .Col = 1
    .Row = 0
    .Text = "NIM"
    .CellFontBold = True
    .ColWidth(1) = 700
    .AllowUserResizing = flexResizeColumns
    .CellAlignment = flexAlignCenterCenter
        
    .Col = 2
    .Row = 0
    .Text = "NAMA MAHASISWA"
    .CellFontBold = True
    .ColWidth(2) = 2000
    .AllowUserResizing = flexResizeColumns
    .CellAlignment = flexAlignCenterCenter
    
    .Col = 3
    .Row = 0
    .Text = "ALAMAT"
    .CellFontBold = True
    .ColWidth(3) = 2000
    .AllowUserResizing = flexResizeColumns
    .CellAlignment = flexAlignCenterCenter
    
    .Col = 4
    .Row = 0
    .Text = "JURUSAN"
    .CellFontBold = True
    .ColWidth(4) = 1500
    .AllowUserResizing = flexResizeColumns
    .CellAlignment = flexAlignCenterCenter
End With
End Sub

Sub TampilGrid()
Dim Baris As String
MSFlexGrid1.Clear
Call AktifGrid
    
MSFlexGrid1.Rows = 2
Baris = 0
Call Buka
RsMhs.Open "SELECT * FROM mhs ORDER BY nim ASC", Conn, adOpenDynamic, adLockOptimistic

If RsMhs.BOF Then
    'MsgBox "Data Kelompok Masih Kosong !", vbInformation, "Perhatian"
    Exit Sub
Else
    With RsMhs
        .MoveFirst
        Do While Not .EOF
        On Error Resume Next
        Baris = Baris + 1
        MSFlexGrid1.Rows = Baris + 1
        MSFlexGrid1.TextMatrix(Baris, 0) = Baris
        MSFlexGrid1.TextMatrix(Baris, 1) = !nim
        MSFlexGrid1.TextMatrix(Baris, 2) = !nama
        MSFlexGrid1.TextMatrix(Baris, 3) = !alamat
        MSFlexGrid1.TextMatrix(Baris, 4) = !jurusan
        .MoveNext
    Loop
    End With
End If
End Sub

Selanjutnya buatlah Module1 sebagai koneksi untuk databasenya dalam project1, dibawah ini adalah kode untuk Module1 :

Public Conn As New ADODB.Connection
Public RsMhs As ADODB.Recordset

Public Sub Buka()
    Set Conn = New ADODB.Connection
    Set RsMhs = New ADODB.Recordset
    Conn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DB_MHS.mdb"
End Sub

Jika semua langkah diatas sudah dilakukan, sekarang pastikan database yang tadi sudah dibuat berada didalam satu folder dengan project yang dibuat, disini anda tidak perlu melakukan pengkoneksian secara manual untuk database dengan project diatas, karena hal itu sudah dipastikan terkoneksi oleh kode listing program diatas, maka jika anda sudah melakukan dengan benar, untuk project Input Data Mahasiswa sudah bisa dijalankan dengan baik.

Pada intinya untuk membuat AutoNumber hanya meletakan kode seperti dibawah ini :

Private Sub AutoNumber()

' Call Buka
' RsMhs.Open ("SELECT * FROM mhs WHERE nim in(select max(nim) from mhs)order by nim desc"), Conn
' RsMhs.Requery

'' // Prosedure membuat nomor otomatis
    Dim Urut As String * 5
    Dim Hitung As Long
    With RsMhs
        If .EOF Then
            Urut = "00001"
            TxtNim = Urut
        Else
            Hitung = Right(!nim, 5) + 1
            Urut = Right("0000" & Hitung, 5)
        End If
        TxtNim = Urut
    End With

End Sub

dan selanjutnya meletakkan kode untuk eksekusi prosedure  Private Sub AutoNumber() pada CommanButton dengan Name "CmdNew" :

Private Sub CmdNew_Click()
'' // Di sinilah untuk Memanggil prosedure penomoran otomatis
    
    AutoNumber  
    TxtNama.Enabled = True
    TxtAlamat.Enabled = True
    TxtJurusan.Enabled = True
    CmdNew.Enabled = False
    CmdSave.Enabled = True
    TxtNama.SetFocus

End Sub

Share this post