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
6. buat sebuah module dan masukan code :Unload Me
Sub FORM()
UserForm1.Show
End Sub
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
4. selesaiDim 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
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
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
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..