Membuat Program Visual Basic Barang

Dari Soal Tersebut Kita akan mulai membuatnya, langsung saja buka Visual Basic dan Sql Server 2005.

From Barang

Untuk Form Suppplier dan form Masuk Sesuaikan dengan Procedurenya.

Maka Untuk membuatnya dengan Sql Sever dengan manual code/coding databasenya adalah sebagai berikut:

create table barang
(
Kdbrg char(4) primary key not null,
Nmbrg varchar(20),
Hrgbrg int,
Jmlbrg smallint
)

create table masuk
(
Kdmsk char(4) primary key not null,
Tglmsk datetime not null,
Jmlmsk smallint not null,
Kdbrg char(4) not null
references barang(Kdbrg)
on update cascade
on delete cascade,
Kdsp char(4) not null
references supplier(Kdsp)
on update cascade
on delete cascade
)

create table supplier
(
Kdsp char(4) primary key not null,
Nmsp varchar(20),
Almsp varchar(20)
)
 

Dan ini Store Procedurenya masing-masing form adalah:


"procedure form barang"

create procedure SP_show_brg
as
select * from barang
go

create procedure SP_show_Kdbrg(@Kdbrg char(4))
as
select * from barang where Kdbrg = @Kdbrg
go

create procedure SP_inst_brg
@vKdbrg char(4),@vNmbrg varchar(20),
@vHrgbrg int,@vJmlbrg smallint
AS
BEGIN
insert into barang(Kdbrg,Nmbrg,Hrgbrg,Jmlbrg)
values (@vKdbrg,@vNmbrg,@vHrgbrg,@vJmlbrg)
if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_updt_brg
@vKdbrg char(4),@vNmbrg varchar(20),
@vHrgbrg int,@vJmlbrg smallint
AS
BEGIN
update barang set Kdbrg=@vKdbrg,Nmbrg=@vNmbrg,Hrgbrg=@vHrgbrg,Jmlbrg=@vJmlbrg
where Kdbrg=@vKdbrg
if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_del_brg
@vKdbrg char(4)
AS
BEGIN
delete barang where Kdbrg=@vKdbrg
if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

"procedure form supllier"

create procedure SP_show_sp
as
select * from supplier
go

create procedure SP_show_Kdsp(@Kdsp char(4))
as
select * from supplier where Kdsp = @Kdsp
go

create procedure SP_inst_sp
@vKdsp char(4),@vNmsp varchar(20),
@vAlmsp varchar(20)
AS
BEGIN
insert into supplier(Kdsp,Nmsp,Almsp)
values (@vKdsp,@vNmsp,@vAlmsp)
if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_updt_sp
@vKdsp char(4),@vNmsp varchar(20),@vAlmsp varchar(20)
as
begin
update supplier set Kdsp=@vKdsp,Nmsp=@vNmsp,Almsp=@vAlmsp
where Kdsp=@vKdsp
if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_del_sp
@Kdsp char(4)
as
begin
delete from supplier where Kdsp=@Kdsp

if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go
"procedure form masuk"

create procedure SP_show_msk
as
select * from masuk
go

create procedure SP_show_Kdmsk(@Kdmsk char(4))
as
select * from masuk where Kdmsk=@Kdmsk
go

create procedure SP_ins_msk
@Kdmsk char(4),@Tglmsk datetime,
@Jmlmsk smallint,@Kdbrg char(4),@Kdsp char(4)
as
begin
insert into masuk values (@Kdmsk,@Tglmsk,@Jmlmsk,@Kdbrg,@Kdsp)

if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_updt_msk
@Kdmsk char(4),@Tglmsk datetime,
@Jmlmsk smallint,@Kdbrg char(4),@Kdsp char(4)
as
begin
update masuk set Kdmsk=@Kdmsk,Tglmsk=@Tglmsk,Jmlmsk=@Jmlmsk,Kdbrg=@Kdbrg,Kdsp=@Kdsp

if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

create procedure SP_del_msk
@Kdmsk char(4)
as
begin
delete from masuk where Kdmsk=@Kdmsk

if @@error <> 0
begin
rollback transaction
end
else
begin
commit transaction
end
end
go

Listing Program di Visual Basic 6.0

Form Barang

Sub RefreshTampilan()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "sp_show_barang"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub


Sub bersih()
txtkdbarang.Text = ""
txtnmbarang.Text = ""
txthrgbarang.Text = ""
txtjmlbarang.Text = ""
End Sub


Private Sub cmdbatal_Click()
Call bersih
End Sub


Private Sub cmdcari_Click()
strSQl = "sp_show_barang_kdbarang '" & txtkdbarang.Text & "'"
LblSQL.Caption = strSQl
Set Rs = Conn.Execute(strSQl)
If Rs.EOF Then
MsgBox ("Data Tidak Ada")
Else
txtkdbarang = Rs("kdbarang")
txtnmbarang = Rs("nmbarang")
txthrgbarang = Rs("hrgbarang")
txtjmlbarang = Rs("jmlbarang")
End If


End Sub


Private Sub cmddelete_Click()
If txtkdbarang.Text = "" Then
MsgBox "Arep Delete Apa?? Kode barang be urung di isi!!!! Nek ora klik isi table sing arep di delete ya kena.", vbOKOnly + vbInformation, "informasi"
txtkdbarang.SetFocus
Exit Sub
End If


On Error GoTo ErrorHand
strSQl = "deletebarang'" & txtkdbarang.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub


Private Sub cmdsimpan_Click()
If txtkdbarang.Text = "" Then
MsgBox "He ...! Kode Barang Kosong...!", vbOKOnly + vbInformation, "informasi"
txtkdbarang.SetFocus
Exit Sub
End If


If txtnmbarang.Text = "" Then
MsgBox "Nama Barang masih Kosong...!", vbOKOnly + vbInformation, "informasi"
txtnmbarang.SetFocus
Exit Sub
End If


If txthrgbarang.Text = "" Then
MsgBox "Tolong harga Barang juga Diisi...!", vbOKOnly + vbInformation, "informasi"
txthrgbarang.SetFocus
Exit Sub
End If


If txtjmlbarang.Text = "" Then
MsgBox "Ehem ehem diisi semua donk", vbOKOnly + vbInformation, "informasi"
txtjmlbarang.SetFocus
Exit Sub
End If


On Error GoTo ErrorHand
strSQl = "insertbarang '" & txtkdbarang.Text & "','" & txtnmbarang.Text & "','" & txthrgbarang.Text & "'," & _
"'" & txtjmlbarang.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub


Private Sub cmdtambah_Click()
Dim SQLMax, kdbarang As String
Dim RsMax As Recordset


SQLMax = "select max(cast(right(kdbarang,2) as int)) as maxkdbarang from barang"
Set RsMax = Conn.Execute(SQLMax)


If IsNull(RsMax("Maxkdbarang")) Then
kdbarang = "BR01"
Else
kdbarang = RsMax("Maxkdbarang")
kdbarang = "BR" & Right("00" & (kdbarang + 1), 2)
End If
Call bersih
txtkdbarang.Text = kdbarang
txtnmbarang.SetFocus
RsMax.Close
Set RsMax = Nothing
End Sub


Private Sub CmdTutup_Click()
Unload Me
End Sub


Private Sub cmdupdate_Click()
On Error GoTo ErrorHand
strSQl = "updatebarang'" & txtkdbarang.Text & "','" & txtnmbarang.Text & "','" & txthrgbarang.Text & "'," & _
"'" & txtjmlbarang.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub


Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
With Adodc1.Recordset
txtkdbarang.Text = .Fields("kdbarang")
txtnmbarang.Text = .Fields("nmbarang")
txthrgbarang.Text = .Fields("hrgbarang")
txtjmlbarang.Text = .Fields("jmlbarang")
End With
End Sub


Private Sub Form_Load()
Call Konek
Call RefreshTampilan


LblSQL.Visible = False
Adodc1.Visible = False
End Sub

From Supplier

Sub RefreshTampilan()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "sp_show_supllier"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub

Sub bersih()
txtkdsupp.Text = ""
txtnmsupp.Text = ""
txtalmtsupp.Text = ""
End Sub

Private Sub cmdbatal_Click()
Call bersih
End Sub

Private Sub cmdcari_Click()
strSQl = "sp_show_supplier_kdsupp '" & txtkdsupp.Text & "'"
LblSQL.Caption = strSQl
Set Rs = Conn.Execute(strSQl)
If Rs.EOF Then
MsgBox ("Data Tidak Ada")
Else
txtkdsupp = Rs("kdsupp")
txtnmsupp = Rs("nmsupp")
txtalmtsupp = Rs("almtsupp")

End If

End Sub

Private Sub cmddelete_Click()
If txtkdsupp.Text = "" Then
MsgBox "Ups  Kode Supplier Diisi dulu", vbOKOnly + vbInformation, "informasi"
txtkdsupp.SetFocus
Exit Sub
End If

On Error GoTo ErrorHand
strSQl = "deletesupplier'" & txtkdsupp.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub

Private Sub cmdsimpan_Click()
If txtkdsupp.Text = "" Then
MsgBox "Kode Supplier Masih Kosong...!", vbOKOnly + vbInformation, "informasi"
txtkdsupp.SetFocus
Exit Sub
End If

If txtnmsupp.Text = "" Then
MsgBox "Dah dibilangin Nama Supplier Masih Kosong...!", vbOKOnly + vbInformation, "informasi"
txtnmsupp.SetFocus
Exit Sub
End If

If txtalmtsupp.Text = "" Then
MsgBox "dah dibilangin Gmana sich Alamat Supplier Diisi Dong", vbOKOnly + vbInformation, "informasi"
txtalmtsupp.SetFocus
Exit Sub
End If

On Error GoTo ErrorHand
strSQl = "insertsupplier '" & txtkdsupp.Text & "','" & txtnmsupp.Text & "','" & txtalmtsupp.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub

Private Sub cmdtambah_Click()
Dim SQLMax, kdsupp As String
Dim RsMax As Recordset

SQLMax = "select max(cast(right(kdsupp,2) as int)) as maxkdsupp from supplier"
Set RsMax = Conn.Execute(SQLMax)

If IsNull(RsMax("Maxkdsupp")) Then
    kdsupp = "SP01"
    Else
    kdsupp = RsMax("Maxkdsupp")
    kdsupp = "SP" & Right("00" & (kdsupp + 1), 2)
    End If
    Call bersih
    txtkdsupp.Text = kdsupp
    txtnmsupp.SetFocus
    RsMax.Close
    Set RsMax = Nothing
End Sub

Private Sub CmdTutup_Click()
Unload Me
End Sub

Private Sub cmdupdate_Click()
On Error GoTo ErrorHand
strSQl = "updatesupplier'" & txtkdsupp.Text & "','" & txtnmsupp.Text & "','" & txtalmtsupp.Text & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub




Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
With Adodc1.Recordset
txtkdsupp.Text = .Fields("kdsupp")
txtnmsupp.Text = .Fields("nmsupp")
txtalmtsupp.Text = .Fields("almtsupp")
End With
End Sub

Private Sub Form_Load()
Call Konek
Call RefreshTampilan

LblSQL.Visible = False
Adodc1.Visible = False
End Sub

Form Masuk

Sub RefreshTampilan()
Call Konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "sp_show_masuk"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Columns(1).NumberFormat = "dd - mmmm -yyyy"
End Sub

Sub bersih()
txtkdmasuk.Text = ""
txtjmlmasuk.Text = ""
End Sub

Private Sub cmdbatal_Click()
Call bersih
End Sub

Private Sub cmdcari_Click()
strSQl = "sp_show_masuk_kdmasuk '" & txtkdmasuk & "'"
LblSQL.Caption = strSQl
Set Rs = Conn.Execute(strSQl)
If Rs.EOF Then
MsgBox ("Data Tidak Ada")
Else
txtkdmasuk = Rs("kdmasuk")
txttglmasuk = Rs("tglmasuk")
txtjmlmasuk = Rs("jmlmasuk")
cmbkdbarang = Rs("kdbarang")
cmbkdsupp = Rs("kdsupp")
End If

End Sub

Private Sub cmddelete_Click()
If txtkdmasuk.Text = "" Then
MsgBox "Sebelum hapus, Kode masuk harus diisi", vbOKOnly + vbInformation, "informasi"
txtkdmasuk.SetFocus
Exit Sub
End If

On Error GoTo ErrorHand
strSQl = "deletemasuk '" & txtkdmasuk & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub

Private Sub CmdTutup_Click()
Unload Me

End Sub

Private Sub cmdsimpan_Click()

If txtkdmasuk.Text = "" Then
MsgBox "Kode masuk masih kosong", vbOKOnly + vbInformation, "informasi"
txtkdmasuk.SetFocus
Exit Sub
End If

If txtjmlmasuk.Text = "" Then
MsgBox "Jumlah Masuk Diisi harus diisi dulu", vbOKOnly + vbInformation, "informasi"
txtjmlmasuk.SetFocus
Exit Sub
End If

On Error GoTo ErrorHand
strSQl = "insertmasuk '" & txtkdmasuk & "','" & txttglmasuk & "','" & txtjmlmasuk & "'," & _
         "'" & cmbkdbarang & "','" & cmbkdsupp & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
End Sub

Private Sub cmdtambah_Click()
Dim SQLMax, kdmasuk As String
Dim RsMax As Recordset

SQLMax = "select max(cast(right(kdmasuk,4) as int)) as maxkdmasuk from masuk"
Set RsMax = Conn.Execute(SQLMax)

If IsNull(RsMax("Maxkdmasuk")) Then
    kdmasuk = "000001"
    Else
    kdmasuk = RsMax("Maxkdmasuk")
    kdmasuk = "00" & Right("0000" & (kdmasuk + 1), 4)
    End If
    Call bersih
    txtkdmasuk.Text = kdmasuk
    txtjmlmasuk.SetFocus
    RsMax.Close
    Set RsMax = Nothing
End Sub

Private Sub cmdupdate_Click()
On Error GoTo ErrorHand
strSQl = "updatemasuk'" & txtkdmasuk & "','" & txttglmasuk & "','" & txtjmlmasuk & "'," & _
         "'" & cmbkdbarang & "','" & cmbkdsupp & "'"
LblSQL.Caption = strSQl
Conn.Execute strSQl
ErrorHand:
If Err.Number <> 0 Then
MsgBox "Ada Kesalahan : " + CStr(Err.Number & vbCrLf & Err.Description), vbCritical + vbOKOnly, "Informasi"
End If
Call RefreshTampilan
Call bersih
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
With Adodc1.Recordset
txtkdmasuk.Text = .Fields("kdmasuk")
txttglmasuk.Text = .Fields("tglmasuk")
txtjmlmasuk.Text = .Fields("jmlmasuk")
cmbkdbarang.Text = .Fields("kdbarang")
cmbkdsupp.Text = .Fields("kdsupp")
End With
End Sub

Private Sub Form_Load()
Call Konek
Call RefreshTampilan
txttglmasuk.Text = Date
'Mengisi ComboBox KdBr
strSQl = "tampilcmbkdbarang"
Set Rs = Conn.Execute(strSQl)
cmbkdbarang.Clear
Do While Not Rs.EOF
cmbkdbarang.AddItem Rs("kdbarang")
Rs.MoveNext
Loop
cmbkdbarang.ListIndex = 0
'Mengisi ComboBox KdSp
strSQl = "tampilcmbkdsupp"
Set Rs = Conn.Execute(strSQl)
cmbkdsupp.Clear
Do While Not Rs.EOF
cmbkdsupp.AddItem Rs("kdsupp")
Rs.MoveNext
Loop
cmbkdsupp.ListIndex = 0

LblSQL.Visible = False
Adodc1.Visible = False
End Sub

Form MDI Form


Private Sub Menu_Click()
End Sub

Private Sub mnbarang_Click()
frmbarang.Show
End Sub

Private Sub mnmasuk_Click()
Form1.Show
End Sub

Private Sub mnmetu_Click()
Unload Me
End Sub

Private Sub mnsupplier_Click()
frmsupp.Show
End Sub

Mengkoneksikan Visual Basic Dengan Database di Sql Server

Pertama yang kita buat adalah Modul Koneksi. Kita buat koneksi didalam modul supaya bisa di panggil dan dikenali semua variabelnya disemua form yang kita buat.
Pilih Menu Project – Add Module kemudian klik Open.
Ketikkan source code untuk modul berikut dengan cara mendouble klik pada object browser di sebelah kanan:

Public conn As New ADODB.Connection
Public rs As New ADODB.Recordset
Public strconnect As String
Public strsql As String
Public Sub konek()
strconnect = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=inventory;Data Source=STMIK-"
If conn.State = adStateOpen Then
conn.Close
Set conn = New ADODB.Connection
conn.Open (strconnect)
Else
conn.Open (strconnect)
End If
End Sub


Ket : Warna hijau adalah alamat koneksi dengan masing-masing komputer Sobat.



Lebih Lanjut Cara Mengkoneksikan...