isi CmdSave_Click dipindahkan ke module dan ganti namanya menjadi Savingdan
ubah menjadi :
Private Sub CmdSave_Click()
Call Saving
End Sub
pindahkan MainTblHeight ke module dimana sub rutin Saving beradaPindahkan
DefineSubTBL ke module dimana sub rutin Saving berada
Ubah kode dari Saving dan DefineSubTBL Sub Saving()' kode diambil dari
CmdSave_Click
' ganti JmlItem = Range(Range("A9"), Range("A9").End(xlDown)).Rows.Count'
menjadi :
Range("A9").Activate
If Range("A9").Offset(1) <> "" Then
JmlItem = Range(Range("A9"), Range("A9").End(xlDown)).Rows.Count
Else
JmlItem = 1
End If
End Sub Private Sub DefineSubTBL() ' Yang di ubah' Set SubTbl
= Range(SubTbl, SubTbl.End(xlDown))' menjadi
If SubTbl.Offset(1) <> "" Then
Set SubTbl = Range(SubTbl, SubTbl.End(xlDown))
End If End Sub
sehingga menjadi : Private Sub Saving()
'----------------------------------
' siti Vi / simple-data-entry
'--------------------21-09-2008----
Dim TblDat As Range
Dim TblSub As Range
Dim NewRow As Long
Dim NewSub As Long
Dim InvItm As Integer
Dim r As Long, c As Integer
Set TblDat = Sheets("DataInv").Range("B3")
Set TblSub = Sheets("DataSub").Range("B3")
With WorksheetFunction
InvItm = .Count(Sheets("InvForm").[c9:c28])
NewRow = .CountA(Sheets("DataInv").[B3:B10000]) + 1
NewSub = .CountA(Sheets("DataSub").Range("B3:B40000"))
End With
Application.Calculation = xlCalculationManual
With Sheets("InvForm")
If .[B5] = "" Then
MsgBox "Nama Pelanggan Belum diisi", 48, "INV Data Entry"
.[B5].Select
Exit Sub
End If
If .[A9] = "" Then
MsgBox "Items Belum diisi", 48, "INV Data Entry"
.[A9].Select
Exit Sub
End If
'--- mengisi tabel induk ----
TblDat(NewRow, 0) = NewRow ' # urut data
TblDat(NewRow, 1) = .[B2] ' nr.inv
TblDat(NewRow, 2) = .[B3] ' inv date
TblDat(NewRow, 2).NumberFormat = "dd mmm yy"
TblDat(NewRow, 3) = .[B5] ' nama
TblDat(NewRow, 4) = .[B6] ' alamat
TblDat(NewRow, 5) = .[D29] ' subTtl
TblDat(NewRow, 6) = .[D30] ' ppn
TblDat(NewRow, 7) = .[D31] ' total
TblDat(NewRow, 8) = InvItm ' juml jenis produk
'--- mengisi tabel anak ----
Dim JmlItem As Byte
' Koreksi
Range("A9").Activate
If Range("A9").Offset(1) <> "" Then
JmlItem = Range(Range("A9"), Range("A9").End(xlDown)).Rows.Count
Else
JmlItem = 1
End If
For r = 1 To JmlItem
If .[A9:D28].Cells(r, 1) = "" Then Exit For
TblSub(NewSub + r, 0) = NewSub + r '# urut
TblSub(NewSub + r, 1) = .[B2] ' Nr Inv
TblSub(NewSub + r, 2) = .[B3] ' Tg Inv
TblSub(NewSub + r, 2).NumberFormat = "dd mmm yy"
TblSub(NewSub + r, 3) = .[B5] ' Nm Cust
For c = 4 To 7
' NmProduk, Harga, Qty, TotalHarga
TblSub(NewSub + r, c) = .[A9:D28].Cells(r, c - 3)
Next c
Next r
'--- reset form
[isian] = "" ' kosongkan isian
.[G2] = .[B2].Value ' inv terakhir di update
.[B3] = Date ' tgl hari ini
.[B5].Select
End With
Call MainTblHeight: Call DefineSubTBL
Application.Calculation = xlCalculationAutomaticEnd Sub
Private Sub DefineSubTBL()
Dim SubTbl As Range
Set SubTbl = Sheets("DataSub").Range("A3")
If SubTbl.Offset(1) <> "" Then
Set SubTbl = Range(SubTbl, SubTbl.End(xlDown))
End If Set SubTbl = Range(SubTbl, SubTbl.End(xlToRight))
SubTbl.Name = "SubTBL"
End Sub
To: [email protected]
From: [email protected]
Date: Tue, 13 Mar 2012 17:32:50 +0800
Subject: [belajar-excel] Simple Invoicing System NYANGKUT!!!!
> saya sedang mempelajari file yang pernah diberikan contoh oleh ba
siti..... sedang asik asik coba belajar, tetapi ada eror pada filenya....>
apakah ada yang bisa membantu membenarkan vbanya atau mencerahkan kenapa bisa
terjadi masalah ? saya coba mengganti cara kerja kami diperusahaan sekarang
yang melakukan rekap penjualan dan pembuatan faktur secara manual...... mohon
bantuannya teman teman,>>> irwan wijaya
