koreksi :
isi CmdSave_Click dicopy ke module dan ganti namanya menjadi Saving
dan kode aslinya ubah menjadi :
Private Sub CmdSave_Click()
Call Saving
End Sub
pindahkan MainTblHeight ke module dimana sub rutin Saving berada
Pindahkan 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 = xlCalculationAutomatic
End 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
