untuk penomoran yang dinamis , walaupun ada baris dihapus ,tetap urut . maka
ganti 1 baris koding saat penyimpanan data dari form ke worksheet : '
ws.Cells(iRow, 1).Value = iRow - 2
' ganti dengan
ws.Cells(iRow, 1).FormulaR1C1 = "=ROW()-2"
To: [email protected]
From: [email protected]
Date: Thu, 1 Dec 2011 08:41:57 +0000
Subject: RE: [belajar-excel] EDIT DATA
jika ingin menghapus ( setelah mengisi nama ) :
Private Sub CommandDelete_Click()
Call SetingTextCommandAWal
' kalau belum ada isian nama , keluar
If BarisIsian = 0 Then Exit Sub
barisnya = BarisIsian & ":" & BarisIsian
Worksheets("Data Induk").Activate
ActiveSheet.Rows(barisnya).Select
Selection.Delete Shift:=xlUp
End Sub
Sub SetingTextCommandAWal()
Call KosongkanText(True)
StatusAksi = ""
BarisIsian = 0
Me.cmdAdd.Caption = "Add/EDit"
Me.cmdClose.Caption = "Close"
End Sub
sehingga koding yang baru :
Dim StatusAksi As String
Dim BarisIsian As Long
Private Sub UserForm_Initialize()
Call IsiTabIndex
Call SetingTextCommandAWal
End Sub
Private Sub cmdAdd_Click()
' Me.cmdAdd.Caption = "Add/EDit"
' Me.cmdClose.Caption = "Close"
Me.txtnam.Locked = False
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Data Induk")
Select Case StatusAksi
Case "ADD"
'find first empty row in database
iRow = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row
Case "EDIT"
iRow = BarisIsian
End Select
'check for a part number
If Trim(Me.txtnam.Value) = "" Then
Me.txtnam.SetFocus
MsgBox "Masukkan Datanya Dulu"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = iRow - 2
ws.Cells(iRow, 2).Value = Me.txtnam.Value
ws.Cells(iRow, 3).Value = Me.txtklmn.Value
ws.Cells(iRow, 4).Value = Me.txtkotlhr.Value
ws.Cells(iRow, 5).Value = Me.txttgllhr.Value
ws.Cells(iRow, 6).Value = Me.txtstat.Value
ws.Cells(iRow, 7).Value = Me.Txtalmt.Value
ws.Cells(iRow, 8).Value = Me.Txtkot.Value
ws.Cells(iRow, 9).Value = Me.txtagam.Value
ws.Cells(iRow, 10).Value = Me.txttglmsk.Value
ws.Cells(iRow, 11).Value = Me.txtunitmsk.Value
ws.Cells(iRow, 12).Value = Me.txtnid.Value
ws.Cells(iRow, 13).Value = Me.txtprk.Value
ws.Cells(iRow, 14).Value = Me.txtjab.Value
ws.Cells(iRow, 15).Value = Me.txtnpwp.Value
ws.Cells(iRow, 16).Value = Me.Txtisteri.Value
ws.Cells(iRow, 17).Value = Me.Txtank1.Value
ws.Cells(iRow, 18).Value = Me.Txtank2.Value
ws.Cells(iRow, 19).Value = Me.Txtank3.Value
Call SetingTextCommandAWal
' StatusAksi = ""
' Call KosongkanText(True)
Me.cmdAdd.SetFocus
End Sub
Private Sub cmdClose_Click()
If StatusAksi = "" Then
Unload Me
Else
Me.txtnam.Locked = False
Call SetingTextCommandAWal
'StatusAksi = ""
'Call KosongkanText(True)
'Me.cmdAdd.Caption = "Add/EDit"
'Me.cmdClose.Caption = "Close"
End If
End Sub
Private Sub CommandDelete_Click()
Call SetingTextCommandAWal
If BarisIsian = 0 Then Exit Sub
barisnya = BarisIsian & ":" & BarisIsian
MsgBox barisnya
Worksheets("Data Induk").Activate
ActiveSheet.Rows(barisnya).Select
Selection.Delete Shift:=xlUp
End Sub
Private Sub txtnam_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift
As Integer)
If (KeyCode = 9 Or KeyCode = 13) And Me.txtnam.Text = "" Then
Me.cmdAdd.SetFocus
End Sub
Private Sub txtnam_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Me.txtnam.Text = "" Then
Cancel = False
Exit Sub
End If
Dim ketemu As Range
Set ketemu = Worksheets("Data Induk").Range("B:B").Find(what:=txtnam.Value,
LookIn:=xlValues, LookAt:=XlLookAt.xlWhole)
If Not ketemu Is Nothing Then
BarisIsian = ketemu.Row
StatusAksi = "EDIT"
Me.txtklmn.Value = ketemu.Offset(0, 1).Value
Me.txtkotlhr.Value = ketemu.Offset(0, 2).Value
Me.txttgllhr.Value = ketemu.Offset(0, 3).Value
Me.txtstat.Value = ketemu.Offset(0, 4).Value
Me.Txtalmt.Value = ketemu.Offset(0, 5).Value
Me.Txtkot.Value = ketemu.Offset(0, 6).Value
Me.txtagam.Value = ketemu.Offset(0, 7).Value
Me.txttglmsk.Value = ketemu.Offset(0, 8).Value
Me.txtunitmsk.Value = ketemu.Offset(0, 9).Value
Me.txtnid.Value = ketemu.Offset(0, 10).Value
Me.txtprk.Value = ketemu.Offset(0, 11).Value
Me.txtjab.Value = ketemu.Offset(0, 12).Value
Me.txtnpwp.Value = ketemu.Offset(0, 13).Value
Me.Txtisteri.Value = ketemu.Offset(0, 14).Value
Me.Txtank1.Value = ketemu.Offset(0, 15).Value
Me.Txtank2.Value = ketemu.Offset(0, 16).Value
Me.Txtank3.Value = ketemu.Offset(0, 17).Value
Else
StatusAksi = "ADD"
Call KosongkanText(False)
End If
On Error Resume Next
Me.cmdAdd.Caption = "Simpan"
Me.cmdClose.Caption = "Cancel"
Me.txtnam.Locked = True
End Sub
Sub KosongkanText(ByVal semua As Boolean)
'clear the data
If semua Then
Me.txtnam.Value = ""
End If
Me.txtklmn.Value = ""
Me.txtkotlhr.Value = ""
Me.txttgllhr.Value = ""
Me.txtstat.Value = ""
Me.Txtalmt.Value = ""
Me.Txtkot.Value = ""
Me.txtagam.Value = ""
Me.txttglmsk.Value = ""
Me.txtunitmsk.Value = ""
Me.txtnid.Value = ""
Me.txtprk.Value = ""
Me.txtjab.Value = ""
Me.txtnpwp.Value = ""
Me.Txtisteri.Value = ""
Me.Txtank1.Value = ""
Me.Txtank2.Value = ""
Me.Txtank3.Value = ""
End Sub
Sub IsiTabIndex()
Me.txtnam.TabIndex = 1
Me.txtklmn.TabIndex = 2
Me.txtkotlhr.TabIndex = 3
Me.txttgllhr.TabIndex = 4
Me.txtstat.TabIndex = 5
Me.Txtalmt.TabIndex = 6
Me.Txtkot.TabIndex = 7
Me.txtagam.TabIndex = 8
Me.txttglmsk.TabIndex = 9
Me.txtunitmsk.TabIndex = 10
Me.txtnid.TabIndex = 11
Me.txtprk.TabIndex = 12
Me.txtjab.TabIndex = 13
Me.txtnpwp.TabIndex = 14
Me.Txtisteri.TabIndex = 15
Me.Txtank1.TabIndex = 16
Me.Txtank2.TabIndex = 17
Me.Txtank3.TabIndex = 18
End Sub
Sub SetingTextCommandAwal()
Call KosongkanText(True)
StatusAksi = ""
BarisIsian = 0
Me.cmdAdd.Caption = "Add/EDit"
Me.cmdClose.Caption = "Close"
End Sub
'===========
catatan : tambahkan commandbutton lalu namai dgn CommandDelete
Semoga sesuai
To: [email protected]
From: [email protected]
Date: Thu, 1 Dec 2011 10:20:40 +0800
Subject: [belajar-excel] EDIT DATA
Salam kenal semuanya para pakar Excel
Saya
pendatang baru, dan langsung ingin minta bantuan dan bertanya masalah edit
data terhadap
data yang pernah kita entrykan karena ternyata ada kesalahan, seperti
contoh berikut :
Supaya jelas saya lampirkan pula contoh file nya.
Terima kasih kepada semua pakar pakar Excel.
Djati W
Surabaya
