Penomoran Otomatis pada VB 6

dalam sebuah pemrograman penomoran sangat penting, karena biasanya penomoran sebagai primary key yang biasanya bersifat unik / tidak bisa sama. kali ini saya akan membuat sebuah perogram penomoran otomatis sederhana dengan menggunakan dua database (acsess dan sql)




1. siapkan tampilan form seperti dibawah ini

- 2 buah textbox
- 2 buah command
- data1
- adodc1
- dbgrid (data bound grid)
- data grid

2. buat data basenya acsess dan sql , kali ini saya hanya memberikan contoh untuk yang sql saja, untuk yang acsess bisa menggunakan visual data manager / ms acsess

- buka query analizer (sql server 2000)
ketiikan rumus
-----------------------------------------------------------------------------------------------------------
create database nomor;
use nomor;

create table nomor(nomor varchar(10));
select * from nomor;
-----------------------------------------------------------------------------------------------------------

3. setelah data base terbentuk atur adodc1 properties (Connection String)

4. buka jendela rumus vb6 (view code) lalu ketikkan rumus di bawah ini


Option Explicit ''untuk jaringan
Public konekdb As ADODB.Connection
Public rsnomor As New ADODB.Recordset
Public sqlstring As String


Sub bukadatabase() ''untuk jaringan
Set konekdb = New ADODB.Connection
konekdb.CursorLocation = adUseClient
konekdb.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=nomor;Data Source=LEF1ATAN-PC"
If konekdb.State = adStateOpen Then
konekdb.Close
Set konekdb = New ADODB.Connection
konekdb.Open
Else
konekdb.Open
End If

End Sub
Private Sub bacadata() ''untuk jaringan
Set rsnomor = New ADODB.Recordset
sqlstring = "select * from nomor"
rsnomor.Open sqlstring, konekdb, adOpenStatic, adLockOptimistic

DataGrid1.Refresh
Set DataGrid1.DataSource = rsnomor
End Sub
''-----------------------------------------------------------------



Private Sub oto1()
Dim Urutan As String * 6
Dim hitung As Long
Dim tgl As String
tgl = Date
On Error GoTo a:
Data1.Recordset.MoveLast

    With Data1
        If .Recordset.EOF Then
a:
            Urutan = "000001"
            Text1.Text = Urutan
        Else
                hitung = Right(.Recordset.Fields!no, 6) + 1
                Urutan = Right("000000" & hitung, 6)
        End If
        Text1.Text = "dcc/" & tgl & Urutan
    End With
End Sub

Private Sub oto2() ''untuk jaringan
Set rsnomor = New ADODB.Recordset
sqlstring = "select * from nomor"
rsnomor.Open sqlstring, konekdb, adOpenStatic, adLockOptimistic

rsnomor.Requery
    Dim Urutan As String * 6
    Dim hitung As Long
    With rsnomor
        If .EOF Then
            Urutan = "000001"
            Text2.Text = Urutan
        Else
        rsnomor.MoveLast
                hitung = Right(rsnomor.Fields!nomor, 6) + 1
                Urutan = Right("000000" & hitung, 6)
        End If
        Text2.Text = Urutan
    End With
End Sub

Private Sub Command1_Click()
Data1.Recordset.AddNew
Data1.Recordset.Fields!no = Text1.Text
Data1.Recordset.Update
Form_Activate
End Sub

Private Sub Command2_Click() ''untuk jaringan
sqlstring = "insert into nomor" _
& "(nomor)" _
& " Values" _
& " ('" & Text2.Text & "')"
konekdb.Execute sqlstring, adCmdText


DataGrid1.Refresh
Form_Activate
End Sub

Private Sub Form_Activate()
Data1.Refresh
Call oto1

'Call bacadata ''untuk jaringan
'Call oto2 ''untuk jaringan

End Sub

Private Sub Form_Load()
'' untuk jaringan
'Call bukadatabase

With Data1
.DatabaseName = App.Path & "\nomor.mdb"
.RecordSource = "nomor"
.Refresh

.RecordsetType = 0
End With



End Sub

5. silahkan di run.... 

mohon masukan nya buat para master , newbe hanya ingin berbagi.... jika ada kesalahan newbe mohon maaf


download project  NO Otomatis