Help agan2 excel master

sh3nmue

New member
gan... ane lagi mau bikin list stock barang.. bisa tolong bantu gan...
ini contoh simplenya
bagaimana caranya supaya stock barang bisa di tambah setelah di klik tambah..
thx all agan2 yg uda mampir n membantu...
 

Attachments

  • vba Stock barang update.jpg
    vba Stock barang update.jpg
    228.7 KB · Views: 735
hahahaha...jangan marah2 toh non...bukan sepi belum di jawab jah kali...benarnya nih bisa di cari di mbah google ...tapi buat apa kita di sini kalau kita masih nyari2 di goolge ya tak??? :)

saya coba ya non...
sepertinya itu dah hampir jadi yah???dah ada penampakan form macronya, meski agak aneh...(maap) program itu mempermudah bukan menyusahkan atuh non, kalau seperti form non itu bisa brabe,kalau ada seribu barang,hayoooo :p


lanjut......

1. setting macronya dulu biar enable,caranya??hm...(tanya lagi kalau ng tau yah)
2. klik visual basic pada tab developer,lalu rancang Form seperti tampilan di bawah :
Publication4.jpg


3. berikan nama Tombol tambah dengan CMDTMBH, dan tombol tutup dengan CMDTTP, textbox kode dengan tkode, textbox nama dengan tnama, textbox stock dengan tstock
4. klik 2x tombol tambah dan isi dengan koding berikut :

Private Sub CMDTMBH_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets(“nama sheet”)

‘menemukan baris kosong pada database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

‘check untuk sebuah kode
If Trim(Me.tkode.Value) = “” Then
Me.tkode.SetFocus
MsgBox “Masukan Kode Barang”
Exit Sub
End If

‘copy data ke database
ws.Cells(iRow, 1).Value = Me.tkode.Value
ws.Cells(iRow, 2).Value = Me.tnama.Value
ws.Cells(iRow, 3).Value = Me.tstock.Value

‘clear data
Me.tkode.Value = “”
Me.tnama.Value = “”
Me.tstock.Value = “”
Me.tkode.SetFocus
End Sub

5. wes...lanjut....klik2x tombol tutup lalu masukan code :
Unload Me
6. buat sebuah module dan masukan code :
Sub FORM()
UserForm1.Show
End Sub

7. kembali ke sheet excel...buatlah sebuah tombol menggunakan shape di sheet, sehingga demikian sheet menjadi seperti ini.
sheet.png


8. klik kanan pada shape dan klik “Assign Macro” dan pilih FORM

kalau sukses tampilan akan seperti ini :
HASIL.png


SEKIAN.

nb: kalau gambar ke gedean tolong kecilin yah mod :)
 
wahhh... thx banget penjelasannya lengkap,,,
btw gan... Uda ane bikin seperti yg agan infokan diatas..
tapi itu selalu menambah baris baru gan...
ane maunya kalo kode barangnya sama.. langsung otomatis tambah stocknya aja
tp kalo masuk kode barang baru, baru ditambahkan ke baris baru,,..
btw thx gan
 
Last edited:
iya..yah...kok lupa yah :p (*ng tau benarnya..hihihii)
oke di coba... :
1. bikin 1 tombol lagi, dengan nama "update",1 text dengan nama add stock(atau apa lah :D ), 1 textbox dengan nama "tada" (*semuanya tanpa kutip dan set properties visiblenya menjadi false)
2. rubah kode di tombol tambah dengan kode berikut :
Private Sub CMDTMBH_Click()
Dim sjd As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim t As Long
Dim sejagad As Range
Dim tod As Long
t = GetTickCount
Dim iRow As Long
Dim l As Long
Dim ws As Worksheet
Set ws = Worksheets("PARTSDATA")

On Error GoTo Err
If Trim(Me.tkode.Value) = "" Then
Me.tkode.SetFocus
MsgBox "Masukan Kode Barang"
Exit Sub
End If
Set sjd = Sheets("PARTSDATA")

lastRow = sjd.Range("A" & Rows.Count).End(xlUp).Row

strSearch = Me.tkode.Text

Set sejagad = sjd.Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not sejagad Is Nothing Then
tod = MsgBox("data di temukan, update data pencet yes!!", vbYesNo, "information")
If tod = vbYes Then
tnama.Text = sejagad.Cells(Row + 1, 2).Value
tstock.Text = sejagad.Cells(Row + 1, 3).Value
tada.Visible = True
Update.Visible = True
Exit Sub
End If

Else
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'copy data ke database
ws.Cells(iRow, 1).Value = Me.tkode.Value
ws.Cells(iRow, 2).Value = Me.tnama.Value
ws.Cells(iRow, 3).Value = Me.tstock.Value


'clear data
Me.tkode.Value = ""
Me.tnama.Value = ""
Me.tstock.Value = ""
Me.tkode.SetFocus
End If
'check untuk sebuah kode
Exit Sub
Err:
MsgBox Err.Description
End Sub

udah???lanjut ... (kok aku jadi yang semnagt yah...ckckck)
3. klik tombol update 2x dan masukan code berikut :
Dim sjd As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim t As Long
Dim sejagad As Range
Dim tod As Long
t = GetTickCount


Set sjd = Sheets("PARTSDATA")

lastRow = sjd.Range("A" & Rows.Count).End(xlUp).Row

strSearch = Me.tkode.Text

Set sejagad = sjd.Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
sejagad.Cells(Row + 1, 2).Value = tnama
sejagad.Cells(Row + 1, 3).Value = CInt(tstock.Text) + CInt(tada.Value)

Me.tkode.Value = ""
Me.tnama.Value = ""
Me.tstock.Value = ""
Me.tada.Value = ""
Me.tkode.SetFocus
update.Visible = False
tada.Visible = False
4. selesai

nb : kali ini ng ada gambarnya t_t soalnya lagi buru-buru..banyak PR....untuk mempercantik kreasi sendiri yah :p, low error posting again lah... :D
 
hahaha bener2 mantap agan sejagad....
uda beres gan... uda bisa n jalan lancaaaarrrrrrrr.....
OK THX BANYAK YA... ane kasih cendolll gan...
 
oiya gan... bisa minta tolong sedikkiiittt lagi,,, hehe...
gimana caranya supaya tidak perlu ada tombol update..
jadi cukup pencet add aja langsung terupdate sendiri..
hehe sory ya jadi merepotkan,,,
 
hahahaha...pindahin aja script update ke bagian tambah....kayaknya bisa dah...
coba d utak atik dulu....soalnya saya lagi pake hp ni.....

liat koding d atas else...pada pilihan vbyesnya masukin koding update tanpa declarasi lagi.:)

ngertikan:p
 
hm...akhirnya saya bisa menulis lagi :)
sepertinya den sh3 tetap ingin seperti gambar pertama yah???
okeh lanjut :

1. hapus coding berserta tombol update.
2.hapus satu lagi text ma textbox add stocknya :(
3. hapus semuaaaaaaaaaaa..... ng kok becanda doank...
4. ganti koding tambah dengan koding berikut.
Private Sub CMDTMBH_Click()
Dim sjd As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim t As Long
Dim sejagad As Range
Dim tod As Long
t = GetTickCount
Dim iRow As Long
Dim l As Long
Dim ws As Worksheet
Set ws = Worksheets("PARTSDATA")

'menemukan baris kosong pada database
On Error GoTo Err
If Trim(Me.tkode.Value) = "" Then
Me.tkode.SetFocus
MsgBox "Masukan Kode Barang"
Exit Sub
End If

Set sjd = Sheets("PARTSDATA")

lastRow = sjd.Range("A" & Rows.Count).End(xlUp).Row

strSearch = Me.tkode.Text

Set sejagad = sjd.Range("A1:A" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not sejagad Is Nothing Then
tod = MsgBox("update data?", vbYesNo, "information")
If tod = vbYes Then
sejagad.Cells(Row + 1, 2).Value = tnama
sejagad.Cells(Row + 1, 3).Value = CInt(tstock.Text) + CInt(sejagad.Cells(Row + 1, 3).Value)
'clear data
Me.tkode.Value = ""
Me.tnama.Value = ""
Me.tstock.Value = ""
Me.tkode.SetFocus
MsgBox "data wes update"
Exit Sub
Else
tkode.SetFocus
Exit Sub
End If
Else
If tnama.Text = "" Then
MsgBox "data tidak di temukan masukan nama barang untuk menambah baru"
tnama.SetFocus
Exit Sub
Else
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
'copy data ke database
ws.Cells(iRow, 1).Value = Me.tkode.Value
ws.Cells(iRow, 2).Value = Me.tnama.Value
ws.Cells(iRow, 3).Value = Me.tstock.Value
'clear data
Me.tkode.Value = ""
Me.tnama.Value = ""
Me.tstock.Value = ""
Me.tkode.SetFocus
End If
End If
Exit Sub
Err:
MsgBox Err.Description
End Sub

nb : untuk update data masukan kode n stock tambahannya, (harus ingat semua kode barang karena tidak ada penampakan nama barang,karena menggunakan satu tombol t_t)

*tidak di sarankan..hehehehe
 
wahahaha agan bnr2 SUUUPERRRRRRR MANTAPPPPZZZZZ!!!
begini yang ane mau gan.... ga sia2 ane kasih cendol ke agan....
hahaha ...
bnr2 makasih banyak gan..... ^^
 
wahhh ga sia2 ane kasih cendol hahaha... agan ini bnr2 mantapppppzpzz
tp msh bingung nih hehe... kalo seperti kyk agan punya ane udah bisa buat nih...
tp kalo seperti yg gambar ane pertama diatas ribet bikin kodenya...
ane bukan buat buku gudang gan..
ane mau buat laporan pertambahan nilai murid berdasarkan nomor absen..
hehe...
 
hahaha bisa kok den...sama aja....liat pada tombol tambah inti nya di sana semua.....
pengkondisian if...



*kompi ane kebanjiran y_y
 
wah... kena banjir ya gan.... moga2 cepet surut ya...
ini nih,, dari contoh agan kmrn ane coba bikin tambahin lg textboxnya... rencana mau bikin banyak.. cuman ane coba 2 dulu... uda dimasukin pake variabel tp kok ga bisa ya... ini penampakan form n kode tombol addnya gan... nanti jawabnya pas banjir da surut aja gan.... hehehe jadi ga enak ganggu master melulu..
oya trus bisa ga gan misalnya nih:
misalnya ane textboxnya uda ada 10 baris nih(10 absen n 10 nilai).. trus ane pas input semua ternyata ada salah satu kotak yg nilainya lupa di input tp absen ada,, ato sebaliknya,, supaya keluar msg box peringatan gitu loh..
tapi keluarnya 1 kali aja gan...
ane pernah buat kyk gitu,, tp peringatannya bisa sampe keluar 20x hadahhhh.... maknyosss klik sampe 20 kali hahaha....
thx gan..

Private Sub CMDTMBH_Click()

Dim lastRow As Long
Dim sejagad As Range
Dim RowCount As Long
Dim l As Long
Dim f As Integer
For f = 1 To 2

'jika kotak kosong
On Error GoTo Err
If Trim(Me.txt1.Value) = "" Then
Me.txt1.SetFocus
MsgBox "Masukan Nilai"
Exit Sub
End If

lastRow = Sheets("PARTSDATA").Range("A" & Rows.Count).End(xlUp).Row

'mencari data sama
Set sejagad = Sheets("PARTSDATA").Range("A1:A" & lastRow).Find(What:=Me.Controls("txt" & f).Value, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not sejagad Is Nothing Then 'jika data sama

sejagad.Cells(Row + 1, 2).Value = CInt(Me.Controls("txtt" & f).Value) + CInt(sejagad.Cells(Row + 1, 2).Value)
'clear data
Me.Controls("txt" & f).Value = ""
Me.Controls("txtt" & f).Value = ""
Me.txt1.SetFocus

Else
RowCount = Worksheets("PARTSDATA").Range("A1").CurrentRegion.Rows.Count
With Worksheets("PARTSDATA").Range("A1") 'untuk tambah data di baris baru
.Offset(RowCount, 0) = Controls("txt" & f).Value
.Offset(RowCount, 1) = Controls("txtt" & f).Value
End With
'clear data
Me.Controls("txt" & f).Value = ""
Me.Controls("txtt" & f).Value = ""
Me.txt1.SetFocus
End If

Exit Sub
Err:
MsgBox Err.Description
Next f
End Sub
 

Attachments

  • Form Nilai.jpg
    Form Nilai.jpg
    142.4 KB · Views: 113
Last edited:
wah... kena banjir ya gan.... moga2 cepet surut ya...
ini nih,, dari contoh agan kmrn ane coba bikin tambahin lg textboxnya... rencana mau bikin banyak.. cuman ane coba 2 dulu... uda dimasukin pake variabel tp kok ga bisa ya... ini penampakan form n kode tombol addnya gan... nanti jawabnya pas banjir da surut aja gan.... hehehe jadi ga enak ganggu master melulu..
oya trus bisa ga gan misalnya nih:
misalnya ane textboxnya uda ada 10 baris nih(10 absen n 10 nilai).. trus ane pas input semua ternyata ada salah satu kotak yg nilainya lupa di input tp absen ada,, ato sebaliknya,, supaya keluar msg box peringatan gitu loh..
tapi keluarnya 1 kali aja gan...
ane pernah buat kyk gitu,, tp peringatannya bisa sampe keluar 20x hadahhhh.... maknyosss klik sampe 20 kali hahaha....
thx gan..

aduh..maaf sekali baru sekarang bisa balas den..maklun kerjaan menumpuk :)
jadi peringatan kolom kosongnya muncul berkali-kali giuh??hadeh...kayak virus ja yah den :)

coba pake perintah "elseif" pada pengecekan kolom kosongnya den....
jadi kayak gini

Private Sub CMDTMBH_Click()

Dim lastRow As Long
Dim sejagad As Range
Dim RowCount As Long
Dim l As Long
Dim f As Integer
For f = 1 To 2

'jika kotak kosong
On Error GoTo Err
If Trim(Me.txt1.Value) = "" Then
Me.txt1.SetFocus
MsgBox "Masukan Nilai"
Exit Sub
elseIf Trim(Me.txt2.Value) = "" Then
Me.txt1.SetFocus
MsgBox "masukan nama"
exit sub
elseif Trim(Me.txt3.Value) = "" Then
Me.txt3.SetFocus
MsgBox "Masukan alamat"
exit sub
'bikin sebanyak textbox yang di butuhkan den...
end if

lastRow = Sheets("PARTSDATA").Range("A" & Rows.Count).End(xlUp).Row

'mencari data sama
Set sejagad = Sheets("PARTSDATA").Range("A1:A" & lastRow).Find(What:=Me.Controls("txt" & f).Value, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

If Not sejagad Is Nothing Then 'jika data sama

sejagad.Cells(Row + 1, 2).Value = CInt(Me.Controls("txtt" & f).Value) + CInt(sejagad.Cells(Row + 1, 2).Value)
'clear data
Me.Controls("txt" & f).Value = ""
Me.Controls("txtt" & f).Value = ""
Me.txt1.SetFocus

Else
RowCount = Worksheets("PARTSDATA").Range("A1").CurrentRegion. Rows.Count
With Worksheets("PARTSDATA").Range("A1") 'untuk tambah data di baris baru
.Offset(RowCount, 0) = Controls("txt" & f).Value
.Offset(RowCount, 1) = Controls("txtt" & f).Value
End With
'clear data
Me.Controls("txt" & f).Value = ""
Me.Controls("txtt" & f).Value = ""
Me.txt1.SetFocus
End If

Exit Sub
Err:
MsgBox Err.Description
Next f
End Sub

thread d i perbaurui karna permintaan seorang sahabat
 
ga bisa juga gan... data yg masuk cuma dari baris pertama aja... baris selanjutnya ga mau masuk datanya... pusiiiinnngg gan/// wakakakaka...
btw bnr2 thx banyak loh gan..
 
data yg masuk cuma baris pertama...owh iya....lupa den.....bros penambahan nya lom d msukin....ntr mlm yah den...skrg lg pake hp...susah buat ngetes script nya jg...ntr saya cb lg.....wait ya den....:)
 
Back
Top