form register 1

Private Sub b1_Click()
    If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
        Call msgSimpan
    Else
        Adodc1.Recordset.Update
        Adodc1.Refresh
        Call nonaktif
        b1.Enabled = False
        b4.Caption = "Keluar"
    End If
End Sub

Private Sub b2_Click()
If b2.Caption = "Edit" Then
    Call aktif
    b2.Caption = "Simpan"
    b4.Caption = "Batal"
    b1.Enabled = False
    b3.Enabled = False
ElseIf b2.Caption = "Simpan" Then
    If Adodc1.Recordset.RecordCount = 0 Then
        Call msgKosong
    Else
        Adodc1.Recordset.Update
        Adodc1.Refresh
        b2.Caption = "Edit"
        b4.Caption = "Keluar"
        b1.Enabled = True
        b3.Enabled = True
        Call nonaktif
    End If
End If
End Sub

Private Sub b3_Click()
If Adodc1.Recordset.RecordCount = 0 Then
    Call msgKosong
Else
pesan = MsgBox("Yakin data ini akan anda hapus?", vbYesNo, "Konfirmasi")
    If pesan = vbYes Then
        Adodc1.Recordset.Delete
        Adodc1.Refresh
    End If
End If
End Sub

Private Sub b4_Click()
If b4.Caption = "Keluar" Then
    Unload Me
    frmUtama.Show
    frmUtama.Enabled = True
ElseIf b4.Caption = "Batal" Then
    Adodc1.Refresh
    Call nonaktif
    b1.Enabled = False
    b4.Caption = "Keluar"
End If
End Sub

Private Sub Form_Load()
Adodc1.Recordset.AddNew
Combo1.Text = "User"
b4.Caption = "Batal"
c1.Value = 0
c2.Value = 0
c3.Value = 0
c4.Value = 0
c5.Value = 0
c6.Value = 0
c7.Value = 0
End Sub

Private Sub aktif()
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Text5.Locked = False
Combo1.Enabled = True
End Sub

Private Sub nonaktif()
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Text5.Locked = True
Combo1.Enabled = False
End Sub

form register

Private Sub b_Click()
If Text1.Text = "" Or Text2.Text = "" Then
    MsgBox "Username atau Password belum diisi!", vbInformation, "Register"
Else
    If Adodc1.Recordset.EOF Then
        pesan = MsgBox("Akun Tersedia, mau di lanjutkan?", vbYesNo, "Register")
        If pesan = vbYes Then
            frmRegister1.Text1.Text = Text1.Text
            frmRegister1.Text2.Text = Text2.Text
            frmRegister1.Show
            Unload Me
        End If
    Else
        MsgBox "Akun tidak tersedia, silahklan gunakan username lain!", vbYesNo, "Register"
        Text1.Text = ""
        Text2.Text = ""
    End If
End If
End Sub

Private Sub bb_Click()
    Unload Me
    frmUtama.Show
    frmUtama.Enabled = True
End Sub


Private Sub Text1_Change()
Dim r As String
r = "select * from login where username like'" & Text1.Text & "'"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = r
Adodc1.Refresh
End Sub

form backup baru

Private Sub xit_Click()
frmUtama.Show
frmUtama.Enabled = True
Unload Me
End Sub

Private Sub p1_Click()
With cdg
    .InitDir = "\\Server_lab\"
    .Filter = "Database SQL Server (*.mdf)|*.mdf"
    .DialogTitle = "Cari Database"
    .ShowOpen
End With
txtfile1.Text = cdg.FileTitle
txtlok1.Text = cdg.FileName
p2.Enabled = True
xit.Enabled = False
End Sub

Private Sub p2_Click()
With cdg
    .InitDir = "C:\"
    .FileName = ""
    .Filter = "Database SQL Server (*.mdf)|*.mdf"
    .DialogTitle = "Simpan dengan nama"
    .ShowSave
End With
txtfile2.Text = cdg.FileTitle
txtlok2.Text = cdg.FileName
Proses.Enabled = True
End Sub

Private Sub p3_Click()
With cdg
    .InitDir = "\\Server_lab\"
    .Filter = "Database SQL Server (*.ldf)|*.ldf"
    .DialogTitle = "Cari Database"
    .ShowOpen
End With
Text1.Text = cdg.FileTitle
Text2.Text = cdg.FileName
p4.Enabled = True
End Sub

Private Sub p4_Click()
With cdg
    .InitDir = "C:\"
    .FileName = ""
    .Filter = "Database SQL Server (*.ldf)|*.ldf"
    .DialogTitle = "Simpan dengan nama"
    .ShowSave
End With
Text.Text = cdg.FileTitle
Text3.Text = cdg.FileName
Proses.Visible = f
Proses2.Enabled = True
End Sub

Private Sub Proses_Click()
Dim jawab As Integer
Dim dirAwal, dirAkhir
jawab = MsgBox("Yakin melakukan backup?", vbYesNo + vbQuestion, "Konfirmasi")
If jawab = 6 Then
    dirAwal = Trim(txtlok1.Text)
    dirAkhir = Trim(txtlok2.Text)
    p3.Enabled = True
    Proses.Visible = False
    Frame1.Visible = False
    Frame2.Visible = False
    Frame3.Visible = True
    Frame4.Visible = True
    On Error GoTo perbaikan
    FileCopy dirAwal, dirAkhir
    MsgBox "Proses backup berhasil!", vbInformation, "Informasi"
    Exit Sub
perbaikan:
MsgBox "Ada kesalahan [" & Err.Description & "]backup tidak dilanjutkan.", vbOKOnly + vbExclamation, "Error"
End If
End Sub

Private Sub Proses2_Click()
Dim jawab As Integer
Dim dirAwal, dirAkhir
jawab = MsgBox("Yakin melakukan backup?", vbYesNo + vbQuestion, "Konfirmasi")
If jawab = 6 Then
    dirAwal = Trim(Text2.Text)
    dirAkhir = Trim(Text3.Text)
    xit.Enabled = True
    On Error GoTo perbaikan
    FileCopy dirAwal, dirAkhir
    MsgBox "Proses backup berhasil!", vbInformation, "Informasi"
    Exit Sub
perbaikan:
MsgBox "Ada kesalahan [" & Err.Description & "]backup tidak dilanjutkan.", vbOKOnly + vbExclamation, "Error"
End If
End Sub

form barang baru

Private Sub b1_Click()

If b1.Caption = "Tambah" Then

    b1.Caption = "Simpan"

    Adodc1.Recordset.AddNew

    Call aktif

    b2.Enabled = False

    b3.Enabled = False

    b4.Caption = "Batal"

ElseIf b1.Caption = "Simpan" Then

    If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then

        Call msgSimpan

    Else

        Adodc1.Recordset.Update

        Adodc1.Refresh

        Call nonaktif

        b1.Caption = "Tambah"

        b4.Caption = "Keluar"

    End If

End If

End Sub

Private Sub b2_Click()

If b2.Caption = "Edit" Then

    Call aktif

    b2.Caption = "Simpan"

    b4.Caption = "Batal"

    b1.Enabled = False

    b3.Enabled = False

ElseIf b2.Caption = "Simpan" Then

    If Adodc1.Recordset.RecordCount = 0 Then

        Call msgKosong

    Else

        Adodc1.Recordset.Update

        Adodc1.Refresh

        b2.Caption = "Edit"

        b4.Caption = "Keluar"

        Call nonaktif

    End If

End If

End Sub

Private Sub b3_Click()

If Adodc1.Recordset.RecordCount = 0 Then

    Call msgKosong

Else

pesan = MsgBox("Yakin data ini akan anda hapus?", vbYesNo, "Konfirmasi")

    If pesan = vbYes Then

        Adodc1.Recordset.Delete

        Adodc1.Refresh

    End If

End If

End Sub

Private Sub b4_Click()

If b4.Caption = "Keluar" Then

    Unload Me

    frmUtama.Show

    frmUtama.Enabled = True

ElseIf b4.Caption = "Batal" Then

    Adodc1.Refresh

    Call nonaktif

    b1.Caption = "Tambah"

    b2.Caption = "Edit"

    b3.Caption = "Hapus"

    b4.Caption = "Keluar"

'    b1.Enabled = True

'    b2.Enabled = True

'    b3.Enabled = True

End If

End Sub

Private Sub c1_Click()

If Adodc1.Recordset.RecordCount = 0 Then

    Call msgKosong

Else

    Adodc1.Recordset.MoveFirst

End If

End Sub

Private Sub c2_Click()

If Adodc1.Recordset.RecordCount = 0 Then

    Call msgKosong

Else

    Adodc1.Recordset.MoveNext

    If Adodc1.Recordset.EOF Then

        Adodc1.Recordset.MoveFirst

    End If

End If

End Sub

Private Sub c3_Click()

If Adodc1.Recordset.RecordCount = 0 Then

    Call msgKosong

Else

    Adodc1.Recordset.MovePrevious

    If Adodc1.Recordset.BOF Then

        Adodc1.Recordset.MoveLast

    End If

End If

End Sub

Private Sub c4_Click()

If Adodc1.Recordset.RecordCount = 0 Then

    Call msgKosong

Else

    Adodc1.Recordset.MoveLast

End If

End Sub

Private Sub Form_Load()

Dim u As String

Adodc1.Visible = False

Call nonaktif

End Sub

Private Sub aktif()

Text1.Locked = False

Text2.Locked = False

Text3.Locked = False

End Sub

Private Sub nonaktif()

Text1.Locked = True

Text2.Locked = True

Text3.Locked = True

End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

'If Not (KeyAscii >= ("0") And KeyAscii <= ("9") Or KeyAscii = vbKeyBack) Then

'    MsgBox "Hanya bisa diinput dengan angka!", vbInformation, "Info"

'End If

'    KeyAscii = 0

End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

'If Not (KeyAscii >= ("0") And KeyAscii <= ("9") Or KeyAscii = vbKeyBack) Then

'    MsgBox "Hanya bisa diinput dengan angka!", vbInformation, "Info"

'    KeyAscii = 0

'End If

End Sub

Private Sub Text4_Change()

Dim u As String

u = "select * from barang where nama_brg like'%" & Text4.Text & "%'"

Adodc1.CommandType = adCmdText

Adodc1.RecordSource = u

Adodc1.Refresh

End Sub

script cari berdasarkan nama

Dim u As String
u = "select * from customer where nama_cust like'%" & Text4.Text & "%'"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = u
Adodc1.Refresh

form barang

Private Sub add_Click()
Adodc2.Recordset.AddNew
Text1.SetFocus

save.Enabled = True
add.Enabled = False
delete.Enabled = False
edit.Enabled = False
Keluar.Enabled = False
End Sub

Private Sub Command1_Click()
Adodc2.Refresh
End Sub
Private Sub datacustomer_Click()
Form1.Show
Unload Me
End Sub

Private Sub DataGrid2_Click()
edit.Enabled = True

End Sub

Private Sub delete_Click()
Adodc2.Recordset.delete
Adodc2.Refresh
Adodc2.Recordset.MoveFirst

save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = True
Keluar.Enabled = True
End Sub

Private Sub edit_Click()
Adodc2.Recordset.Update

save.Enabled = True
add.Enabled = True
delete.Enabled = True
edit.Enabled = False
Keluar.Enabled = True
End Sub

Private Sub Form_Activate()
save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = False
Keluar.Enabled = True
End Sub


Private Sub keluar_Click()
If MsgBox("yakin mau keluar ??", vbOKCancel + vbCritical, "WARNING !") = vbOK Then
Form3.Show
Else
End If
End Sub

Private Sub save_Click()
Adodc2.Recordset.save

save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = True
Keluar.Enabled = True
End Sub

Private Sub Timer1_Timer()
Label7.Caption = Format(Time)
End Sub

form data customer

Private Sub add_Click()
Adodc1.Recordset.AddNew
Text2.SetFocus

save.Enabled = True
add.Enabled = False
delete.Enabled = False
edit.Enabled = False
keluar.Enabled = False
End Sub

Private Sub Command1_Click()
Adodc1.Refresh
End Sub


Private Sub databarang_Click()
Form2.Show
Unload Me
End Sub

Private Sub DataGrid1_Click()
edit.Enabled = True
End Sub

Private Sub delete_Click()
Adodc1.Recordset.delete
Adodc1.Refresh
Adodc1.Recordset.MoveFirst

save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = True
keluar.Enabled = True
End Sub

Private Sub edit_Click()
Adodc1.Recordset.Update

save.Enabled = True
add.Enabled = True
delete.Enabled = True
edit.Enabled = False
keluar.Enabled = True
End Sub


Private Sub Form_Activate()
save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = False
keluar.Enabled = True
End Sub


Private Sub keluar_Click()
If MsgBox("yakin mau keluar ??", vbOKCancel + vbCritical, "WARNING !") = vbOK Then
Form3.Show
Else
End If
End Sub

Private Sub save_Click()
Adodc1.Recordset.Update

save.Enabled = False
add.Enabled = True
delete.Enabled = True
edit.Enabled = True
keluar.Enabled = True
End Sub

Private Sub Timer1_Timer()
Label7.Caption = Format(Time)
End Sub

TRANSAKSI PENJUALAN

 

Dim kdCUS, kdBRG As String

Private Sub b1_Click()
Dim jml As String
Call kosong

T2.SetFocus
jml = Adodc3.Recordset.RecordCount
If jml = 0 Then
 T2.Text = "PEN001"
 ElseIf jml >= 100 Then
 T2.Text = "PEN" & jml + 1

 ElseIf jml >= 10 Then
 T2.Text = "PEN0" & jml + 1

 ElseIf jml <= 9 Then
 T2.Text = "PEN00" & jml + 1
 End If

b2.Enabled = True
b1.Enabled = False
b4.Enabled = False
b5.Enabled = False
b3.Enabled = False
End Sub

Private Sub b2_Click()
Adodc3.Recordset.AddNew
Adodc3.Recordset!NOPENJ = T2.Text
Adodc3.Recordset!TGLPENJ = T1.Text
Adodc3.Recordset!JUMPENJ = t4.Text
Adodc3.Recordset!BYRPENJ = T8.Text
Adodc3.Recordset!IDCUS = C1.Text
Adodc3.Recordset!IDBRG = C2.Text
Adodc3.Recordset.Update
Call kosong

b2.Enabled = False
b1.Enabled = True
b4.Enabled = True
b5.Enabled = True
b3.Enabled = True
End Sub

Private Sub b3_Click()
If MsgBox("yakin mau keluar ??", vbOKCancel + vbCritical, "WARNING !") = vbOK Then
End
Else
End If
End Sub

Private Sub b4_Click()
Adodc3.Recordset.delete
Adodc3.Refresh
Adodc3.Recordset.MoveFirst

b2.Enabled = False
b1.Enabled = True
n4.Enabled = True
b5.Enabled = True
b3.Enabled = True
End Sub

Private Sub b5_Click()
Adodc3.Recordset.Update

b2.Enabled = True
b1.Enabled = True
b4.Enabled = True
b5.Enabled = False
b3.Enabled = True
End Sub

Private Sub c1_Click(Area As Integer)
kdCUS = ""
    Set CUS = conn.Execute("SELECT * FROM " _
        & " CUSTOMER WHERE IDCUS='" _
        & C1.Text & "'")
       
    With CUS
        If .EOF And .BOF Then
            Exit Sub
        Else
            kdCUS = CUS!IDCUS
            t3.Text = CUS!NMCUS
'            Text4.Text = kdCUS!hrg
'            DataCombo1.SetFocus
        End If
    End With
End Sub
'Private Sub DataCombo1_DropDown()
'Combo1.Clear
'    Set CUS = conn.Execute("select * from " _
'        & " CUSTOMER order by IDCUS")
'
'    If Not CUS.BOF Then
'        While Not CUS.EOF
'         DataCombo1.AddItem CUS!IDCUS
'         CUS.MoveNext
'         Wend
'    End If
'End Sub


Private Sub c2_Click(Area As Integer)
kdBRG = ""
    Set BRG = conn.Execute("SELECT * FROM " _
        & " BARANG WHERE IDBRG='" _
        & C2.Text & "'")
       
    With BRG
        If .EOF And .BOF Then
            Exit Sub
        Else
            kdBRG = BRG!IDBRG
            t6.Text = BRG!NMBRG
            t7.Text = BRG!HRGBRG
'            Text4.Text = kdCUS!hrg
'            DataCombo1.SetFocus
        End If
    End With

End Sub



Private Sub Form_Activate()
T1.Text = Format(Date, "dd-mm-yyyy")
End Sub

Private Sub Form_Load()
opendb
'Text1.Text = Format(Date, "dd-mm-yyy")
End Sub
Private Sub t4_Change()
t5.Text = Val(t7.Text) * Val(t4.Text)
End Sub

Private Sub T8_Change()
T9.Text = Val(T8.Text) - Val(t5.Text)
End Sub

Private Sub Timer1_Timer()
Label13.Caption = Format(Time)
End Sub


Private Sub WanButton1_Click()
Form1.Show
End Sub

Private Sub WanButton2_Click()
Form2.Show
End Sub
Sub kosong()
'T1.Text = ""
T2.Text = ""
t3.Text = ""
t4.Text = ""
t5.Text = ""
t6.Text = ""
t7.Text = ""
T8.Text = ""
T9.Text = ""
C1.Text = ""
C2.Text = ""
End Sub

script untuk modul penjualan menggunakan visual basic 06

Untuk sebuah program membutuhan sebuahmodul yang digunnakan dalam pembuatan program penjualan agar mempermudah kinerja admin dalam menyelesaikan sebuah project.. berikut nii modulnya yya..

Option Explicit
Public conn As ADODB.Connection
Public CUS As ADODB.Recordset
Public BRG As ADODB.Recordset
Public PENJUALAN As ADODB.Recordset
Public SqlInsert As String
Public SqlUpdate As String
Public cmd As ADODB.Command
Public dbServer As String
Public Sub opendb()
Dim dbUser As String, dbPassword As String, dbName As String
dbUser = "LAT_UKK"
dbPassword = "UKK"
dbName = "UKK"
dbServer = "CRACKER"
Set conn = New ADODB.Connection
conn.Open "Provider=SQLOLEDB.1;User ID=" & dbUser & ";Password=" & dbPassword & ";Initial Catalog=" & dbName & ";Data Source =" & dbServer
End Sub

Public Function OpenTable(sqlStr As String) As ADODB.Recordset
Set OpenTable = New ADODB.Rrcordset
OpenTable.Open sqlStr, conn, adOpenDynamic, adLockOptimistic
End Function

Public Sub ExecQuery(sqlStr As String)
Set cmd = New ADODB.Command
cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
cmd.CommandText = sqlStr
cmd.Execute
End Sub

semogga bermanfaat yya nii modull..
mavv klo gga gto jelas karena saya pun sedang dalam masa pembelajaran..
terimakasih..

Script untuk penulisan ID Otomatis dalam Visual Basic 0.6

Untuk sebuah program membutuhan sebuah ID otomatis agar mempermudah user dalam memedakan data yang lain dengan data yang lainnya. dan untuk meminimalisir kesalahan dalam penulisan id pada sebuah tabel  dan berikut nii adalah scriptnya nii ..


Dim jml As String
Call kosong

TxtNoPenjualan.SetFocus
jml = datapenjualan.Recordset.RecordCount
If jml = 0 Then
TxtNoPenjualan.Text = "PEN001"
 ElseIf jml >= 100 Then
TxtNoPenjualan.Text = "PEN" & jml + 1

 ElseIf jml >= 10 Then
TxtNoPenjualan.Text = "PEN0" & jml + 1

 ElseIf jml <= 9 Then
TxtNoPenjualan.Text = "PEN00" & jml + 1
 End If


semogga bermanfaat yya..
khafie10.com