Modul untuk Mengelola Aktivitas Akuntansi

Aktivitas akuntansi dimulai dari pembuatan kode rekening. Kode rekening ini akan digunakan dalam pencatatan jurnal transaksi, pembuatan buku besar, neraca lajur sampai dengan diterbitkannya laporan keuangan.

Aktivitas lainnya adalah membuat jurnal transaksi. Jurnal transaksi merupakan pusat dari seluruh aktivitas akuntansi, karena dari sinilah semua bentuk laporan dibuat. Jadi, kesalahan dalam pembuatan jurnal transaksi, baik dalam kode rekening, keterangan, jumlah kuantitas, referensi, maupun jumlah rupiah didebit atau dikredit bisa berakibat laporan keuangan menjadi salah interpretasi. Sofware akuntansi yang baik harus mempunyai kontrol terhadap pembuatan jurnal transaksi. Tentu saja, peran manusia adalah yang utama, karena sofware akuntansi hanya membantu memudahkan pekerjaan manusia menjadi lebih efisien dan efektif.

Berikut ini adalah modul yang digunakan untuk mengelola aktivitas akuntansi.

view plainprint?

1. '------------------------------------------  
2. ' Attribute VB_Name = "mdlTransJurnal"  
3. ' Modul ini berisi fungsi-fungsi yang digunakan   
4. ' untuk mengelola aktivitas akuntansi seperti  
5. ' mengelola kode rekening, jurnal transaksi,   
6. ' buku besar, neraca lajur, dan budget.   
7. '   
8. ' Author: Bambang Subroto,   
9. ' email: bambang.subro@gmail.com  
10. '   
11. '------------------------------------------  
12. Option Compare Database  
13. Public globStatusJurnal As String  
14. Public globSumberBukuBesar As String  
15. Public globNeracaLajur As String  
16. Public Enum JenisTB  
17.   HanyaKodeRekUtama = 0  
18.   Lengkap = 1  
19. End Enum  
20. Function HitungSaldoAwal(intJenisTB As JenisTB, strKodeRek As String, dtTgl As Date, _  
21.                         Optional strDeriv1 As Variant, Optional strDeriv2 As Variant) As Double  
22. '------------------------------------------  
23. ' Fungsi untuk menghitung saldo awal  
24. ' pada neraca lajur  
25. '------------------------------------------  
26.   Dim strCriteria As Variant  
27.   Dim SaldoAwalDebit, SaldoAwalKredit As Double  
28. On Error GoTo Err_Msg  
29.   If intJenisTB = HanyaKodeRekUtama Then  
30.     strCriteria = Null  
31.   Else  
32.     If strDeriv1 <> "" Then  
33.       strCriteria = " and [Deriv1]='" & strDeriv1 & "'"  
34.     Else  
35.       strCriteria = " and [Deriv1] is null"  
36.     End If  
37.     If strDeriv2 <> "" Then  
38.       strCriteria = strCriteria & " and [Deriv2]='" & strDeriv2 & "'"  
39.     Else  
40.       strCriteria = strCriteria & " and [Deriv2] is null"  
41.     End If  
42.   End If  
43.   SaldoAwalDebit = Nz(DSum("[Debit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] < #" & dtTgl & "#"), 0)  
44.   SaldoAwalKredit = Nz(DSum("[Kredit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] < #" & dtTgl & "#"), 0)  
45.   HitungSaldoAwal = SaldoAwalDebit - SaldoAwalKredit  
46. Exit_Function:  
47.   Exit Function  
48. Err_Msg:  
49.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
50.   Resume Exit_Function  
51. End Function  
52. Function HitungSaldoAkhir(intJenisTB As JenisTB, strKodeRek As String, dtTgl As Date, _  
53.                         Optional strDeriv1 As Variant, Optional strDeriv2 As Variant) As Double  
54. '------------------------------------------  
55. ' Fungsi untuk menghitung saldo akhir  
56. ' pada neraca lajur  
57. '------------------------------------------  
58.   Dim strCriteria As Variant  
59.   Dim SaldoAkhirDebit, SaldoAkhirKredit As Double  
60. On Error GoTo Err_Msg  
61.   If intJenisTB = HanyaKodeRekUtama Then  
62.     strCriteria = Null  
63.   Else  
64.     If strDeriv1 <> "" Then  
65.       strCriteria = " and [Deriv1]='" & strDeriv1 & "'"  
66.     Else  
67.       strCriteria = " and [Deriv1] is null"  
68.     End If  
69.     If strDeriv2 <> "" Then  
70.       strCriteria = strCriteria & " and [Deriv2]='" & strDeriv2 & "'"  
71.     Else  
72.       strCriteria = strCriteria & " and [Deriv2] is null"  
73.     End If  
74.   End If  
75.   SaldoAkhirDebit = Nz(DSum("[Debit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] <= #" & dtTgl & "#"), 0)  
76.   SaldoAkhirKredit = Nz(DSum("[Kredit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] <= #" & dtTgl & "#"), 0)  
77.   HitungSaldoAkhir = SaldoAkhirDebit - SaldoAkhirKredit  
78. Exit_Function:  
79.   Exit Function  
80. Err_Msg:  
81.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
82.   Resume Exit_Function  
83. End Function  
84. Function CekAdaJurnalTipeSama(tgl As Date, Optional TipeJurnal As String) As Variant  
85. '------------------------------------------------------------  
86. ' Fungsi yang digunakan untuk mengecek apakah ada jurnal  
87. ' dengan tipe jurnal yang sama tetapi pada periode sebelumnya.  
88. ' Fungsi ini digunakan dalam proses saat posting jurnal ke buku besar  
89. '------------------------------------------------------------  
90.   Dim dbs As Database  
91.   Dim rst As Recordset  
92.   Dim strSqlx, strMsg, strTipeJurnal As String  
93. On Error GoTo Err_Msg  
94.   If TipeJurnal <> "" Then strTipeJurnal = "TipeJurnal='" & TipeJurnal & "' and "  
95.   Set dbs = CurrentDb  
96.   strSqlx = "SELECT TglTransaksi, TipeJurnal, JurnalId FROM tblTempTransJournal_Parent " _  
97.           & "WHERE " & strTipeJurnal & " Format([tgltransaksi],'yyyymm')< '" & Format(tgl, "yyyymm") & "';"  
98.   Set rst = dbs.OpenRecordset(strSqlx, dbOpenSnapshot)  
99.   Do While Not rst.EOF  
100.     strMsg = strMsg & "Tgl Transaksi: " & rst!TglTransaksi & ", Tipe Jurnal: " & rst!TipeJurnal & ", JurnalId #" & rst!JurnalId & vbCrLf  
101.     rst.MoveNext  
102.   Loop  
103.   CekAdaJurnalTipeSama = strMsg  
104.   rst.Close  
105.   Set rst = Nothing  
106. Exit_Function:  
107.   Exit Function  
108. Err_Msg:  
109.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
110.   Resume Exit_Function  
111. End Function  
112. Function TampilkanNoJurnalPermanen(strTipeJurnal As String, dtTanggal As Date) As Integer  
113. '------------------------------------------  
114. ' Fungsi untuk menampilkan nomor jurnal permanen  
115. ' bila sebuah jurnal temporer akan diproses/diposting  
116. '------------------------------------------  
117.   Dim dtTglTerkahir As Date  
118.   Dim intJumlahJurnal As Integer  
119. On Error GoTo Err_Msg  
120.   If ValidPeriode(dtTanggal) Then  
121.     If PreferensSistem("NoJurnalKeAwal") = True Then  
122.       TampilkanNoJurnalPermanen = DCount("[TipeJurnal]", "tblPermTransJournal_Parent", "[TipeJurnal]='" & strTipeJurnal & "' and [TglTransaksi] between #" & CekPeriode("TglAwalThn") & "# and #" & CekPeriode("TglAkhirThn") & "#") + 1  
123.       Exit Function  
124.     Else  
125.       dtTglTerakhir = DMax("[TglTransaksi]", "tblPermTransJournal_Parent", "[TipeJurnal]='" & strTipeJurnal & "'")  
126.       intJumlahJurnal = DMax("[NoJurnal]", "tblPermTransJournal_Parent", "[TglTransaksi]=#" & dtTglTerakhir & "#")  
127.       TampilkanNoJurnalPermanen = intJumlahJurnal + 1  
128.       Exit Function  
129.     End If  
130.   End If  
131. Exit_Function:  
132.   Exit Function  
133. Err_Msg:  
134.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
135.   Resume Exit_Function  
136. End Function  
137. Function HapusQueryNeracaLajur()  
138. '------------------------------------------  
139. ' Fungsi untuk menghapus tabel/query yang dihasilkan  
140. ' setelah selesainya sebuah proses pembuatan  
141. ' neraca lajur. Untuk keamanan data,  
142. ' maka tabel/query itu harus dihapus.  
143. '------------------------------------------  
144. On Error GoTo Err_Msg  
145.   HapusObjekYgTidakPerlu "qryNeracaLajurAwal"  
146.   HapusObjekYgTidakPerlu "qryNeracaLajurMutasi"  
147.   HapusObjekYgTidakPerlu "qryNeracaLajurGabung"  
148.   HapusObjekYgTidakPerlu "qryNeracaLajurGabung1"  
149.   HapusObjekYgTidakPerlu "qryNeracaLajurGabung0"  
150. Exit_Function:  
151.   Exit Function  
152. Err_Msg:  
153.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
154.   Resume Exit_Function  
155. End Function  
156.   
157. Function BuatQueryNeracaLajur(dtdrTglTransaksi, dtsdTglTransaksi As Date, _  
158.                               stdrKodeRek, stdrDeriv1, stdrDeriv2, stsdKodeRek, stsdDeriv1, stsdDeriv2 As Variant)  
159. '------------------------------------------  
160. ' Fungsi untuk membuat tabel/query yang  
161. ' digunakan dalam proses pembuatan  
162. ' neraca lajur.  
163. '------------------------------------------  
164.   Dim strQueryNama, strSqla As String  
165. On Error GoTo Err_Msg  
166. 'Buat saldo awal neraca lajur  
167.   strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Sum([JmlhDebit]-[JmlhKredit]) AS SaldoAwal, " _  
168.               & "JmlhDebit, JmlhKredit, Grup FROM qryPermTransJurnal WHERE TglTransaksi < #" & dtdrTglTransaksi & "# " _  
169.               & "AND KodeGabung between '" & stdrKodeRek & stdrDeriv1 & stdrDeriv2 & "' and '" _  
170.               & stsdKodeRek & stsdDeriv1 & stsdDeriv2 & "' " _  
171.               & "GROUP BY KodeGabung, KodeRek, Deriv1, Deriv2, JmlhDebit, JmlhKredit, Grup;"  
172.   BuatQuery "qryNeracaLajurAwal", strSqla  
173.     
174.   'Buat Mutasi debit kredit neraca lajur  
175.   strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Grup, 0 AS SaldoAwal, Sum(JmlhDebit) AS SumOfJmlhDebit, " _  
176.               & "Sum(JmlhKredit) AS SumOfJmlhKredit, Sum(PenyesDebit) AS SumOfPenyesDebit, Sum(PenyesKredit) AS SumOfPenyesKredit " _  
177.               & "FROM qryPermTransJurnal WHERE TglTransaksi Between #" & dtdrTglTransaksi & "# and #" & dtsdTglTransaksi & "# " _  
178.               & "AND KodeGabung between '" & stdrKodeRek & stdrDeriv1 & stdrDeriv2 & "' and '" _  
179.               & stsdKodeRek & stsdDeriv1 & stsdDeriv2 & "' " _  
180.               & "GROUP BY KodeGabung, KodeRek, Deriv1, Deriv2, Grup, 0; "  
181.   BuatQuery "qryNeracaLajurMutasi", strSqla  
182.   strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Grup, SaldoAwal, 0 AS SumOfJmlhDebit, 0 AS SumOfJmlhKredit, 0 AS SumOfPenyesDebit, " _  
183.               & "0 AS SumOfPenyesKredit FROM qryNeracaLajurAwal " _  
184.               & "UNION select KodeGabung, KodeRek, Deriv1, Deriv2, Grup, SaldoAwal, SumOfJmlhDebit, SumOfJmlhKredit, SumOfPenyesDebit, " _  
185.               & "SumOfPenyesKredit FROM qryNeracaLajurMutasi;"  
186.   BuatQuery "qryNeracaLajurGabung", strSqla  
187.   strSqla = "SELECT KodeRek, Deriv1, Deriv2, Grup,  Sum([qryNeracaLajurGabung]![SaldoAwal]) AS SaldoAwal, Sum(SumOfJmlhDebit) AS Debit, Sum(SumOfJmlhKredit) AS Kredit, " _  
188.               & "Sum(SumOfPenyesDebit) AS PenyDebit, Sum(SumOfPenyesKredit) AS PenyKredit, " _  
189.               & "[SaldoAwal]+[Debit]+[PenyDebit]-[Kredit]-[PenyKredit] AS SaldoAkhir FROM qryNeracaLajurGabung " _  
190.               & "GROUP BY KodeRek, Deriv1, Deriv2, Grup ORDER BY KodeRek, Deriv1, Deriv2;"  
191.   BuatQuery "qryNeracaLajurGabung1", strSqla  
192.   strSqla = "SELECT KodeRek, Grup, Sum(qryNeracaLajurGabung1.SaldoAwal) AS SaldoAwal, Sum(qryNeracaLajurGabung1.Debit) AS Debit, " _  
193.               & "Sum(qryNeracaLajurGabung1.Kredit) AS Kredit, Sum(qryNeracaLajurGabung1.PenyDebit) AS PenyDebit, " _  
194.               & "Sum(qryNeracaLajurGabung1.PenyKredit) AS PenyKredit, Sum(qryNeracaLajurGabung1.SaldoAkhir) AS SaldoAkhir " _  
195.               & "FROM qryNeracaLajurGabung1 GROUP BY qryNeracaLajurGabung1.KodeRek, qryNeracaLajurGabung1.Grup;"  
196.   BuatQuery "qryNeracaLajurGabung0", strSqla  
197. Exit_Function:  
198.   Exit Function  
199. Err_Msg:  
200.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
201.   Resume Exit_Function  
202. End Function  
203. Function BuatSemuaBB(jnsTB As JenisTB, strKodeRek As String, dtTglAwal As Date, dtTglAkhir As Date, Optional strDeriv1 As String, Optional strDeriv2 As String)  
204. '------------------------------------------  
205. ' Fungsi untuk membuat tabel/query  
206. ' yang digunakan dalam proses pembuatan  
207. ' buku besar.  
208. '------------------------------------------  
209.   Dim dbs As Database  
210.   Dim rst As Recordset  
211.   Dim strSqlx, strSqla, strSqlb, Deriv1, Deriv2, strDerivs1, strDerivs2 As String  
212.   Dim dblSaldoAwal, dblDebit, dblKredit As Double  
213.   Dim intCounter As Integer  
214.   Dim dtInitVal As Date  
215. On Error GoTo Err_Msg  
216.   dtInitVal = 0  
217.   intCounter = 0  
218.   'Cek Saldo Awal  
219.   If jnsTB = Lengkap Then  
220.     dblSaldoAwal = HitungSaldoAwal(Lengkap, strKodeRek, dtTglAwal, strDeriv1, strDeriv2)  
221.   Else  
222.     dblSaldoAwal = HitungSaldoAwal(HanyaKodeRekUtama, strKodeRek, dtTglAwal)  
223.   End If  
224.   If dblSaldoAwal < 0 Then  
225.     dblDebit = 0  
226.     dblKredit = -dblSaldoAwal  
227.   Else  
228.     dblDebit = dblSaldoAwal  
229.     dblKredit = 0  
230.   End If  
231.   'buat tabel tblBukuBesar dan masukkan nilai saldo awal  
232.   Deriv1 = "'" & strDeriv1 & "', "  
233.   Deriv2 = "'" & strDeriv2 & "', "  
234.   If strDeriv1 = "" Then  
235.     Deriv1 = "Null, "  
236.   End If  
237.   If strDeriv2 = "" Then  
238.     Deriv2 = "Null, "  
239.   End If  
240.   If jnsTB = Lengkap Then  
241.     strDerivs1 = "And Deriv1 ='" & strDeriv1 & "' "  
242.     strDerivs2 = "And Deriv2 ='" & strDeriv2 & "';"  
243.     If strDeriv1 = "" Then  
244.       strDerivs1 = "AND Deriv1 Is Null "  
245.     End If  
246.     If strDeriv2 = "" Then  
247.       strDerivs2 = "AND Deriv2 Is Null;"  
248.     End If  
249.   End If  
250.   DoCmd.SetWarnings False  
251.   strSqla = "INSERT INTO tblBukuBesar ( TglTransaksi,  Deskripsi, KodeRek, Deriv1, Deriv2, Debit, Kredit, SaldoAkhir,NoUrut ) " _  
252.               & "VALUES (#" & dtTglAwal & "#, 'Saldo Awal', '" & strKodeRek & "', " _  
253.               & Deriv1 & Deriv2 & "0,0, " & dblSaldoAwal & ", " & intCounter & ");"  
254.   DoCmd.RunSQL strSqla  
255.   'tambahkan transaksi ke tblBukuBesar  
256.   strSqlb = "SELECT JurnalId, TipeJurnal, NoJurnal, TglTransaksi, IIf([Ref]='',Null,[Ref]) AS Refss, NoRef, NoUrut, " _  
257.               & "RefDetail, KodeRek, Deskripsi, Deriv1, Deriv2, Kuantitas, SU, HargaSatuan, TotalJumlah, Debit, Kredit, JthTempo " _  
258.               & "FROM qryPermTransJurnal " _  
259.               & "WHERE TglTransaksi Between #" & dtTglAwal & "# And #" & dtTglAkhir & "# AND KodeRek='" & strKodeRek & "' " _  
260.               & strDerivs1 & strDerivs2  
261.   Set dbs = CurrentDb  
262.   Set rst = dbs.OpenRecordset(strSqlb, dbOpenSnapshot)  
263.   Do While Not rst.EOF  
264.     If Not IsNull(rst!Refss) Then Refss = "'" & rst!Refss & "'" Else Refss = "Null"  
265.     If Not IsNull(rst!NoRef) Then NoRefss = "" & rst!NoRef & "" Else NoRefss = "Null"  
266.     If Not IsNull(rst!RefDetail) Then RefssDetail = "'" & rst!RefDetail & "'" Else RefssDetail = "Null"  
267.     If Not IsNull(rst!Deriv1) Then sDeriv1 = "'" & rst!Deriv1 & "'" Else sDeriv1 = "Null"  
268.     If Not IsNull(rst!Deriv2) Then sDeriv2 = "'" & rst!Deriv2 & "'" Else sDeriv2 = "Null"  
269.     If Not IsNull(rst!JthTempo) Then JthTempos = "#" & rst!JthTempo & "#" Else JthTempos = "Null"  
270.     If Not IsNull(rst!SU) Then SUs = "'" & rst!SU & "'" Else SUs = "Null"  
271.     dblSaldoAwal = dblSaldoAwal + rst!Debit - rst!Kredit  
272.     intCounter = intCounter + 1  
273.     strSqla = "INSERT INTO tblBukuBesar (JurnalId, TipeJurnal, NoJurnal,  TglTransaksi, " _  
274.                 & "Ref, NoRef, RefDetail, Deskripsi, KodeRek, " _  
275.                 & "Deriv1, Deriv2, Kuantitas, SU, HargaSatuan, " _  
276.                 & "TotalJumlah, Debit, Kredit, SaldoAkhir, JthTempo, NoUrut ) " _  
277.                 & "VALUES (" & rst!JurnalId & ", '" & rst!TipeJurnal & "', " & rst!NoJurnal & ", #" & rst!TglTransaksi & "#, " _  
278.                 & Refss & ", " & NoRefss & ", " & RefssDetail & ", '" & rst!Deskripsi & "', '" & rst!KodeRek & "', " _  
279.                 & sDeriv1 & ", " & sDeriv2 & ", " & rst!Kuantitas & ", " & SUs & ", " & rst!HargaSatuan & ", " _  
280.                 & rst!TotalJumlah & ", " & rst!Debit & ", " & rst!Kredit & ", " & dblSaldoAwal & ", " & JthTempos & ", " _  
281.                 & intCounter & ");"  
282.     DoCmd.RunSQL strSqla  
283.     rst.MoveNext  
284.   Loop  
285.   rst.Close  
286.   Set rst = Nothing  
287.   DoCmd.SetWarnings True  
288. Exit_Function:  
289.   Exit Function  
290. Err_Msg:  
291.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
292.   Resume Exit_Function  
293. End Function  
294. Function BuatTabelBukuBesar()  
295. '------------------------------------------  
296. ' Fungsi untuk membuat tabel/query  
297. ' yang digunakan dalam proses pembuatan  
298. ' buku besar.  
299. '------------------------------------------  
300.   Dim obj As AccessObject, dbsObject As Object  
301.   Dim dbs As DAO.Database  
302.   Dim tdf As DAO.TableDef  
303.   Dim fld As DAO.Field2  
304. On Error GoTo Err_Msg  
305.   Set dbsObject = Application.CurrentData  
306.   For Each obj In dbsObject.AllTables  
307.     If obj.Name = "tblBukuBesar" Then  
308.       DoCmd.DeleteObject acTable, obj.Name  
309.     End If  
310.   Next obj  
311.   Set dbs = CurrentDb()  
312.   ' membuat tabel dengan nama tblBukuBesar  
313.   Set tdf = dbs.CreateTableDef("tblBukuBesar")  
314.   ' membuat field untk tblBukuBesar  
315.   tdf.Fields.Append tdf.CreateField("JurnalId", dbLong)  
316.   tdf.Fields.Append tdf.CreateField("TipeJurnal", dbText, 3)  
317.   tdf.Fields.Append tdf.CreateField("NoJurnal", dbLong)  
318.   tdf.Fields.Append tdf.CreateField("TglTransaksi", dbDate)  
319.   tdf.Fields.Append tdf.CreateField("Ref", dbText, 50)  
320.   tdf.Fields.Append tdf.CreateField("NoRef", dbLong)  
321.   tdf.Fields.Append tdf.CreateField("NoUrut", dbLong)  
322.   tdf.Fields.Append tdf.CreateField("RefDetail", dbText, 50)  
323.   tdf.Fields.Append tdf.CreateField("KodeRek", dbText, 3)  
324.   tdf.Fields.Append tdf.CreateField("Deskripsi", dbText, 100)  
325.   tdf.Fields.Append tdf.CreateField("Deriv1", dbText, 3)  
326.   tdf.Fields.Append tdf.CreateField("Deriv2", dbText, 3)  
327.   tdf.Fields.Append tdf.CreateField("Kuantitas", dbDouble)  
328.   tdf.Fields.Append tdf.CreateField("SU", dbText, 12)  
329.   tdf.Fields.Append tdf.CreateField("HargaSatuan", dbDouble)  
330.   tdf.Fields.Append tdf.CreateField("TotalJumlah", dbDouble)  
331.   tdf.Fields.Append tdf.CreateField("Debit", dbDouble)  
332.   tdf.Fields.Append tdf.CreateField("Kredit", dbDouble)  
333.   tdf.Fields.Append tdf.CreateField("SaldoAkhir", dbDouble)  
334.   tdf.Fields.Append tdf.CreateField("JthTempo", dbDate)  
335.   dbs.TableDefs.Append tdf  
336.   dbs.Close  
337. Cleanup:  
338.     Set tdf = Nothing  
339.     Set dbs = Nothing  
340. Exit_Function:  
341.   Exit Function  
342. Err_Msg:  
343.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
344.   Resume Exit_Function  
345. End Function  
346. Function ImporBudgetDariExcel()  
347. '------------------------------------------  
348. ' Fungsi untuk mengimpor data excel  
349. ' dan menampikannya dalam bentuk form sementara.  
350. '------------------------------------------  
351.   Dim obj As AccessObject, dbsObject As Object  
352.   Dim dbs As DAO.Database  
353.   Dim tdf As DAO.TableDef  
354.   Dim fld As DAO.Field2  
355.   Dim frm As Form  
356.   Dim ctlData As Control  
357.   Dim ctlLabel As Control  
358.   Dim leftInch As Single  
359.   Dim strSqla As String  
360.   Dim n, topInch, widthInch, heightInch As Integer '1440 twips = 1 inch  
361. On Error GoTo Err_Msg  
362.       
363.   Set dbsObject = Application.CurrentProject ' .CurrentData  
364.   For Each obj In dbsObject.AllForms  
365.     If obj.Name = "frmImporBudgetSubform" Then  
366.       DoCmd.DeleteObject acForm, obj.Name  
367.     End If  
368.   Next obj  
369.   DoCmd.SetWarnings False  
370.     
371.   Set dbs = CurrentDb()  
372.   Set tdf = dbs.TableDefs("tblBudgetImpor")  
373.     
374.   Set frm = CreateForm  
375.   frm.RecordSource = "qryBudgetImpor"  
376.   frm.DefaultView = 2  
377.   frm.Width = 1.3 * 1440  
378.   frm.AllowAdditions = False  
379.   frm.AllowEdits = False  
380.   frm.AllowDeletions = False  
381.   frm.RecordSelectors = 0  
382.   frm.NavigationButtons = 0  
383.   leftInch = 0.0833  
384.   topInch = 0  
385.   widthInch = 1440  
386.   heightInch = 1440  
387.   n = 0  
388.   For Each fld In tdf.Fields  
389.     If n = 0 Then  
390.       strSqla = "SELECT tblBudgetImpor.* FROM tblBudgetImpor WHERE ((Not (tblBudgetImpor." & fld.Name & ") Is Null)) " _  
391.                   & " ORDER BY tblBudgetImpor." & fld.Name & ";"  
392.       BuatQuery "qryBudgetImpor", strSqla  
393.     End If  
394.     If n <= 2 Then  
395.       Set ctlData = CreateControl(frm.Name, acComboBox, acDetail, , fld.Name, 1.2833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)  
396.       ctlData.Name = fld.Name  
397.       Set ctlLabel = CreateControl(frm.Name, acLabel, acDetail, ctlData.Name, fld.Name, 0.0833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)  
398.       ctlLabel.Name = "lbl" & fld.Name  
399.       If n = 0 Then ctlData.RowSource = "tblRekUtama"  
400.       If n = 1 Then ctlData.RowSource = "tblRekDerivatif1"  
401.       If n = 2 Then ctlData.RowSource = "tblRekDerivatif2"  
402.       ctlData.ColumnCount = 2  
403.       ctlData.ColumnWidths = "1440;2880"  
404.       ctlData.ColumnHeads = 1  
405.       ctlData.ListWidth = 1440 + 2880  
406.       ctlData.Format = ""  
407.     Else  
408.       Set ctlData = CreateControl(frm.Name, acTextBox, acDetail, , fld.Name, 1.2833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)  
409.       ctlData.Name = fld.Name  
410.       Set ctlLabel = CreateControl(frm.Name, acLabel, acDetail, ctlData.Name, fld.Name, 0.0833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)  
411.       ctlLabel.Name = "lbl" & fld.Name  
412.       ctlData.Format = "Standard"  
413.     End If  
414.     n = n + 1  
415.   Next fld  
416.   DoCmd.Save , "frmImporBudgetSubform"  
417.   
418.   DoCmd.Close acForm, "frmImporBudgetSubform", acSaveYes  
419.   DoCmd.SetWarnings True  
420. Exit_Function:  
421.   Exit Function  
422. Err_Msg:  
423.   MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description  
424.   Resume Exit_Function  
425. End Function  

'------------------------------------------
' Attribute VB_Name = "mdlTransJurnal"
' Modul ini berisi fungsi-fungsi yang digunakan 
' untuk mengelola aktivitas akuntansi seperti
' mengelola kode rekening, jurnal transaksi, 
' buku besar, neraca lajur, dan budget. 
' 
' Author: Bambang Subroto, 
' email: bambang.subro@gmail.com
' 
'------------------------------------------
Option Compare Database
Public globStatusJurnal As String
Public globSumberBukuBesar As String
Public globNeracaLajur As String
Public Enum JenisTB
  HanyaKodeRekUtama = 0
  Lengkap = 1
End Enum
Function HitungSaldoAwal(intJenisTB As JenisTB, strKodeRek As String, dtTgl As Date, _
                        Optional strDeriv1 As Variant, Optional strDeriv2 As Variant) As Double
'------------------------------------------
' Fungsi untuk menghitung saldo awal
' pada neraca lajur
'------------------------------------------
  Dim strCriteria As Variant
  Dim SaldoAwalDebit, SaldoAwalKredit As Double
On Error GoTo Err_Msg
  If intJenisTB = HanyaKodeRekUtama Then
    strCriteria = Null
  Else
    If strDeriv1 <> "" Then
      strCriteria = " and [Deriv1]='" & strDeriv1 & "'"
    Else
      strCriteria = " and [Deriv1] is null"
    End If
    If strDeriv2 <> "" Then
      strCriteria = strCriteria & " and [Deriv2]='" & strDeriv2 & "'"
    Else
      strCriteria = strCriteria & " and [Deriv2] is null"
    End If
  End If
  SaldoAwalDebit = Nz(DSum("[Debit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] < #" & dtTgl & "#"), 0)
  SaldoAwalKredit = Nz(DSum("[Kredit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] < #" & dtTgl & "#"), 0)
  HitungSaldoAwal = SaldoAwalDebit - SaldoAwalKredit
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function HitungSaldoAkhir(intJenisTB As JenisTB, strKodeRek As String, dtTgl As Date, _
                        Optional strDeriv1 As Variant, Optional strDeriv2 As Variant) As Double
'------------------------------------------
' Fungsi untuk menghitung saldo akhir
' pada neraca lajur
'------------------------------------------
  Dim strCriteria As Variant
  Dim SaldoAkhirDebit, SaldoAkhirKredit As Double
On Error GoTo Err_Msg
  If intJenisTB = HanyaKodeRekUtama Then
    strCriteria = Null
  Else
    If strDeriv1 <> "" Then
      strCriteria = " and [Deriv1]='" & strDeriv1 & "'"
    Else
      strCriteria = " and [Deriv1] is null"
    End If
    If strDeriv2 <> "" Then
      strCriteria = strCriteria & " and [Deriv2]='" & strDeriv2 & "'"
    Else
      strCriteria = strCriteria & " and [Deriv2] is null"
    End If
  End If
  SaldoAkhirDebit = Nz(DSum("[Debit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] <= #" & dtTgl & "#"), 0)
  SaldoAkhirKredit = Nz(DSum("[Kredit]", "qryPermTransJurnal", "[KodeRek]='" & strKodeRek & "'" & strCriteria & " and [TglTransaksi] <= #" & dtTgl & "#"), 0)
  HitungSaldoAkhir = SaldoAkhirDebit - SaldoAkhirKredit
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function CekAdaJurnalTipeSama(tgl As Date, Optional TipeJurnal As String) As Variant
'------------------------------------------------------------
' Fungsi yang digunakan untuk mengecek apakah ada jurnal
' dengan tipe jurnal yang sama tetapi pada periode sebelumnya.
' Fungsi ini digunakan dalam proses saat posting jurnal ke buku besar
'------------------------------------------------------------
  Dim dbs As Database
  Dim rst As Recordset
  Dim strSqlx, strMsg, strTipeJurnal As String
On Error GoTo Err_Msg
  If TipeJurnal <> "" Then strTipeJurnal = "TipeJurnal='" & TipeJurnal & "' and "
  Set dbs = CurrentDb
  strSqlx = "SELECT TglTransaksi, TipeJurnal, JurnalId FROM tblTempTransJournal_Parent " _
          & "WHERE " & strTipeJurnal & " Format([tgltransaksi],'yyyymm')< '" & Format(tgl, "yyyymm") & "';"
  Set rst = dbs.OpenRecordset(strSqlx, dbOpenSnapshot)
  Do While Not rst.EOF
    strMsg = strMsg & "Tgl Transaksi: " & rst!TglTransaksi & ", Tipe Jurnal: " & rst!TipeJurnal & ", JurnalId #" & rst!JurnalId & vbCrLf
    rst.MoveNext
  Loop
  CekAdaJurnalTipeSama = strMsg
  rst.Close
  Set rst = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function TampilkanNoJurnalPermanen(strTipeJurnal As String, dtTanggal As Date) As Integer
'------------------------------------------
' Fungsi untuk menampilkan nomor jurnal permanen
' bila sebuah jurnal temporer akan diproses/diposting
'------------------------------------------
  Dim dtTglTerkahir As Date
  Dim intJumlahJurnal As Integer
On Error GoTo Err_Msg
  If ValidPeriode(dtTanggal) Then
    If PreferensSistem("NoJurnalKeAwal") = True Then
      TampilkanNoJurnalPermanen = DCount("[TipeJurnal]", "tblPermTransJournal_Parent", "[TipeJurnal]='" & strTipeJurnal & "' and [TglTransaksi] between #" & CekPeriode("TglAwalThn") & "# and #" & CekPeriode("TglAkhirThn") & "#") + 1
      Exit Function
    Else
      dtTglTerakhir = DMax("[TglTransaksi]", "tblPermTransJournal_Parent", "[TipeJurnal]='" & strTipeJurnal & "'")
      intJumlahJurnal = DMax("[NoJurnal]", "tblPermTransJournal_Parent", "[TglTransaksi]=#" & dtTglTerakhir & "#")
      TampilkanNoJurnalPermanen = intJumlahJurnal + 1
      Exit Function
    End If
  End If
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function HapusQueryNeracaLajur()
'------------------------------------------
' Fungsi untuk menghapus tabel/query yang dihasilkan
' setelah selesainya sebuah proses pembuatan
' neraca lajur. Untuk keamanan data,
' maka tabel/query itu harus dihapus.
'------------------------------------------
On Error GoTo Err_Msg
  HapusObjekYgTidakPerlu "qryNeracaLajurAwal"
  HapusObjekYgTidakPerlu "qryNeracaLajurMutasi"
  HapusObjekYgTidakPerlu "qryNeracaLajurGabung"
  HapusObjekYgTidakPerlu "qryNeracaLajurGabung1"
  HapusObjekYgTidakPerlu "qryNeracaLajurGabung0"
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function

Function BuatQueryNeracaLajur(dtdrTglTransaksi, dtsdTglTransaksi As Date, _
                              stdrKodeRek, stdrDeriv1, stdrDeriv2, stsdKodeRek, stsdDeriv1, stsdDeriv2 As Variant)
'------------------------------------------
' Fungsi untuk membuat tabel/query yang
' digunakan dalam proses pembuatan
' neraca lajur.
'------------------------------------------
  Dim strQueryNama, strSqla As String
On Error GoTo Err_Msg
'Buat saldo awal neraca lajur
  strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Sum([JmlhDebit]-[JmlhKredit]) AS SaldoAwal, " _
              & "JmlhDebit, JmlhKredit, Grup FROM qryPermTransJurnal WHERE TglTransaksi < #" & dtdrTglTransaksi & "# " _
              & "AND KodeGabung between '" & stdrKodeRek & stdrDeriv1 & stdrDeriv2 & "' and '" _
              & stsdKodeRek & stsdDeriv1 & stsdDeriv2 & "' " _
              & "GROUP BY KodeGabung, KodeRek, Deriv1, Deriv2, JmlhDebit, JmlhKredit, Grup;"
  BuatQuery "qryNeracaLajurAwal", strSqla
  
  'Buat Mutasi debit kredit neraca lajur
  strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Grup, 0 AS SaldoAwal, Sum(JmlhDebit) AS SumOfJmlhDebit, " _
              & "Sum(JmlhKredit) AS SumOfJmlhKredit, Sum(PenyesDebit) AS SumOfPenyesDebit, Sum(PenyesKredit) AS SumOfPenyesKredit " _
              & "FROM qryPermTransJurnal WHERE TglTransaksi Between #" & dtdrTglTransaksi & "# and #" & dtsdTglTransaksi & "# " _
              & "AND KodeGabung between '" & stdrKodeRek & stdrDeriv1 & stdrDeriv2 & "' and '" _
              & stsdKodeRek & stsdDeriv1 & stsdDeriv2 & "' " _
              & "GROUP BY KodeGabung, KodeRek, Deriv1, Deriv2, Grup, 0; "
  BuatQuery "qryNeracaLajurMutasi", strSqla
  strSqla = "SELECT KodeGabung, KodeRek, Deriv1, Deriv2, Grup, SaldoAwal, 0 AS SumOfJmlhDebit, 0 AS SumOfJmlhKredit, 0 AS SumOfPenyesDebit, " _
              & "0 AS SumOfPenyesKredit FROM qryNeracaLajurAwal " _
              & "UNION select KodeGabung, KodeRek, Deriv1, Deriv2, Grup, SaldoAwal, SumOfJmlhDebit, SumOfJmlhKredit, SumOfPenyesDebit, " _
              & "SumOfPenyesKredit FROM qryNeracaLajurMutasi;"
  BuatQuery "qryNeracaLajurGabung", strSqla
  strSqla = "SELECT KodeRek, Deriv1, Deriv2, Grup,  Sum([qryNeracaLajurGabung]![SaldoAwal]) AS SaldoAwal, Sum(SumOfJmlhDebit) AS Debit, Sum(SumOfJmlhKredit) AS Kredit, " _
              & "Sum(SumOfPenyesDebit) AS PenyDebit, Sum(SumOfPenyesKredit) AS PenyKredit, " _
              & "[SaldoAwal]+[Debit]+[PenyDebit]-[Kredit]-[PenyKredit] AS SaldoAkhir FROM qryNeracaLajurGabung " _
              & "GROUP BY KodeRek, Deriv1, Deriv2, Grup ORDER BY KodeRek, Deriv1, Deriv2;"
  BuatQuery "qryNeracaLajurGabung1", strSqla
  strSqla = "SELECT KodeRek, Grup, Sum(qryNeracaLajurGabung1.SaldoAwal) AS SaldoAwal, Sum(qryNeracaLajurGabung1.Debit) AS Debit, " _
              & "Sum(qryNeracaLajurGabung1.Kredit) AS Kredit, Sum(qryNeracaLajurGabung1.PenyDebit) AS PenyDebit, " _
              & "Sum(qryNeracaLajurGabung1.PenyKredit) AS PenyKredit, Sum(qryNeracaLajurGabung1.SaldoAkhir) AS SaldoAkhir " _
              & "FROM qryNeracaLajurGabung1 GROUP BY qryNeracaLajurGabung1.KodeRek, qryNeracaLajurGabung1.Grup;"
  BuatQuery "qryNeracaLajurGabung0", strSqla
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function BuatSemuaBB(jnsTB As JenisTB, strKodeRek As String, dtTglAwal As Date, dtTglAkhir As Date, Optional strDeriv1 As String, Optional strDeriv2 As String)
'------------------------------------------
' Fungsi untuk membuat tabel/query
' yang digunakan dalam proses pembuatan
' buku besar.
'------------------------------------------
  Dim dbs As Database
  Dim rst As Recordset
  Dim strSqlx, strSqla, strSqlb, Deriv1, Deriv2, strDerivs1, strDerivs2 As String
  Dim dblSaldoAwal, dblDebit, dblKredit As Double
  Dim intCounter As Integer
  Dim dtInitVal As Date
On Error GoTo Err_Msg
  dtInitVal = 0
  intCounter = 0
  'Cek Saldo Awal
  If jnsTB = Lengkap Then
    dblSaldoAwal = HitungSaldoAwal(Lengkap, strKodeRek, dtTglAwal, strDeriv1, strDeriv2)
  Else
    dblSaldoAwal = HitungSaldoAwal(HanyaKodeRekUtama, strKodeRek, dtTglAwal)
  End If
  If dblSaldoAwal < 0 Then
    dblDebit = 0
    dblKredit = -dblSaldoAwal
  Else
    dblDebit = dblSaldoAwal
    dblKredit = 0
  End If
  'buat tabel tblBukuBesar dan masukkan nilai saldo awal
  Deriv1 = "'" & strDeriv1 & "', "
  Deriv2 = "'" & strDeriv2 & "', "
  If strDeriv1 = "" Then
    Deriv1 = "Null, "
  End If
  If strDeriv2 = "" Then
    Deriv2 = "Null, "
  End If
  If jnsTB = Lengkap Then
    strDerivs1 = "And Deriv1 ='" & strDeriv1 & "' "
    strDerivs2 = "And Deriv2 ='" & strDeriv2 & "';"
    If strDeriv1 = "" Then
      strDerivs1 = "AND Deriv1 Is Null "
    End If
    If strDeriv2 = "" Then
      strDerivs2 = "AND Deriv2 Is Null;"
    End If
  End If
  DoCmd.SetWarnings False
  strSqla = "INSERT INTO tblBukuBesar ( TglTransaksi,  Deskripsi, KodeRek, Deriv1, Deriv2, Debit, Kredit, SaldoAkhir,NoUrut ) " _
              & "VALUES (#" & dtTglAwal & "#, 'Saldo Awal', '" & strKodeRek & "', " _
              & Deriv1 & Deriv2 & "0,0, " & dblSaldoAwal & ", " & intCounter & ");"
  DoCmd.RunSQL strSqla
  'tambahkan transaksi ke tblBukuBesar
  strSqlb = "SELECT JurnalId, TipeJurnal, NoJurnal, TglTransaksi, IIf([Ref]='',Null,[Ref]) AS Refss, NoRef, NoUrut, " _
              & "RefDetail, KodeRek, Deskripsi, Deriv1, Deriv2, Kuantitas, SU, HargaSatuan, TotalJumlah, Debit, Kredit, JthTempo " _
              & "FROM qryPermTransJurnal " _
              & "WHERE TglTransaksi Between #" & dtTglAwal & "# And #" & dtTglAkhir & "# AND KodeRek='" & strKodeRek & "' " _
              & strDerivs1 & strDerivs2
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset(strSqlb, dbOpenSnapshot)
  Do While Not rst.EOF
    If Not IsNull(rst!Refss) Then Refss = "'" & rst!Refss & "'" Else Refss = "Null"
    If Not IsNull(rst!NoRef) Then NoRefss = "" & rst!NoRef & "" Else NoRefss = "Null"
    If Not IsNull(rst!RefDetail) Then RefssDetail = "'" & rst!RefDetail & "'" Else RefssDetail = "Null"
    If Not IsNull(rst!Deriv1) Then sDeriv1 = "'" & rst!Deriv1 & "'" Else sDeriv1 = "Null"
    If Not IsNull(rst!Deriv2) Then sDeriv2 = "'" & rst!Deriv2 & "'" Else sDeriv2 = "Null"
    If Not IsNull(rst!JthTempo) Then JthTempos = "#" & rst!JthTempo & "#" Else JthTempos = "Null"
    If Not IsNull(rst!SU) Then SUs = "'" & rst!SU & "'" Else SUs = "Null"
    dblSaldoAwal = dblSaldoAwal + rst!Debit - rst!Kredit
    intCounter = intCounter + 1
    strSqla = "INSERT INTO tblBukuBesar (JurnalId, TipeJurnal, NoJurnal,  TglTransaksi, " _
                & "Ref, NoRef, RefDetail, Deskripsi, KodeRek, " _
                & "Deriv1, Deriv2, Kuantitas, SU, HargaSatuan, " _
                & "TotalJumlah, Debit, Kredit, SaldoAkhir, JthTempo, NoUrut ) " _
                & "VALUES (" & rst!JurnalId & ", '" & rst!TipeJurnal & "', " & rst!NoJurnal & ", #" & rst!TglTransaksi & "#, " _
                & Refss & ", " & NoRefss & ", " & RefssDetail & ", '" & rst!Deskripsi & "', '" & rst!KodeRek & "', " _
                & sDeriv1 & ", " & sDeriv2 & ", " & rst!Kuantitas & ", " & SUs & ", " & rst!HargaSatuan & ", " _
                & rst!TotalJumlah & ", " & rst!Debit & ", " & rst!Kredit & ", " & dblSaldoAwal & ", " & JthTempos & ", " _
                & intCounter & ");"
    DoCmd.RunSQL strSqla
    rst.MoveNext
  Loop
  rst.Close
  Set rst = Nothing
  DoCmd.SetWarnings True
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function BuatTabelBukuBesar()
'------------------------------------------
' Fungsi untuk membuat tabel/query
' yang digunakan dalam proses pembuatan
' buku besar.
'------------------------------------------
  Dim obj As AccessObject, dbsObject As Object
  Dim dbs As DAO.Database
  Dim tdf As DAO.TableDef
  Dim fld As DAO.Field2
On Error GoTo Err_Msg
  Set dbsObject = Application.CurrentData
  For Each obj In dbsObject.AllTables
    If obj.Name = "tblBukuBesar" Then
      DoCmd.DeleteObject acTable, obj.Name
    End If
  Next obj
  Set dbs = CurrentDb()
  ' membuat tabel dengan nama tblBukuBesar
  Set tdf = dbs.CreateTableDef("tblBukuBesar")
  ' membuat field untk tblBukuBesar
  tdf.Fields.Append tdf.CreateField("JurnalId", dbLong)
  tdf.Fields.Append tdf.CreateField("TipeJurnal", dbText, 3)
  tdf.Fields.Append tdf.CreateField("NoJurnal", dbLong)
  tdf.Fields.Append tdf.CreateField("TglTransaksi", dbDate)
  tdf.Fields.Append tdf.CreateField("Ref", dbText, 50)
  tdf.Fields.Append tdf.CreateField("NoRef", dbLong)
  tdf.Fields.Append tdf.CreateField("NoUrut", dbLong)
  tdf.Fields.Append tdf.CreateField("RefDetail", dbText, 50)
  tdf.Fields.Append tdf.CreateField("KodeRek", dbText, 3)
  tdf.Fields.Append tdf.CreateField("Deskripsi", dbText, 100)
  tdf.Fields.Append tdf.CreateField("Deriv1", dbText, 3)
  tdf.Fields.Append tdf.CreateField("Deriv2", dbText, 3)
  tdf.Fields.Append tdf.CreateField("Kuantitas", dbDouble)
  tdf.Fields.Append tdf.CreateField("SU", dbText, 12)
  tdf.Fields.Append tdf.CreateField("HargaSatuan", dbDouble)
  tdf.Fields.Append tdf.CreateField("TotalJumlah", dbDouble)
  tdf.Fields.Append tdf.CreateField("Debit", dbDouble)
  tdf.Fields.Append tdf.CreateField("Kredit", dbDouble)
  tdf.Fields.Append tdf.CreateField("SaldoAkhir", dbDouble)
  tdf.Fields.Append tdf.CreateField("JthTempo", dbDate)
  dbs.TableDefs.Append tdf
  dbs.Close
Cleanup:
    Set tdf = Nothing
    Set dbs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function ImporBudgetDariExcel()
'------------------------------------------
' Fungsi untuk mengimpor data excel
' dan menampikannya dalam bentuk form sementara.
'------------------------------------------
  Dim obj As AccessObject, dbsObject As Object
  Dim dbs As DAO.Database
  Dim tdf As DAO.TableDef
  Dim fld As DAO.Field2
  Dim frm As Form
  Dim ctlData As Control
  Dim ctlLabel As Control
  Dim leftInch As Single
  Dim strSqla As String
  Dim n, topInch, widthInch, heightInch As Integer '1440 twips = 1 inch
On Error GoTo Err_Msg
    
  Set dbsObject = Application.CurrentProject ' .CurrentData
  For Each obj In dbsObject.AllForms
    If obj.Name = "frmImporBudgetSubform" Then
      DoCmd.DeleteObject acForm, obj.Name
    End If
  Next obj
  DoCmd.SetWarnings False
  
  Set dbs = CurrentDb()
  Set tdf = dbs.TableDefs("tblBudgetImpor")
  
  Set frm = CreateForm
  frm.RecordSource = "qryBudgetImpor"
  frm.DefaultView = 2
  frm.Width = 1.3 * 1440
  frm.AllowAdditions = False
  frm.AllowEdits = False
  frm.AllowDeletions = False
  frm.RecordSelectors = 0
  frm.NavigationButtons = 0
  leftInch = 0.0833
  topInch = 0
  widthInch = 1440
  heightInch = 1440
  n = 0
  For Each fld In tdf.Fields
    If n = 0 Then
      strSqla = "SELECT tblBudgetImpor.* FROM tblBudgetImpor WHERE ((Not (tblBudgetImpor." & fld.Name & ") Is Null)) " _
                  & " ORDER BY tblBudgetImpor." & fld.Name & ";"
      BuatQuery "qryBudgetImpor", strSqla
    End If
    If n <= 2 Then
      Set ctlData = CreateControl(frm.Name, acComboBox, acDetail, , fld.Name, 1.2833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)
      ctlData.Name = fld.Name
      Set ctlLabel = CreateControl(frm.Name, acLabel, acDetail, ctlData.Name, fld.Name, 0.0833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)
      ctlLabel.Name = "lbl" & fld.Name
      If n = 0 Then ctlData.RowSource = "tblRekUtama"
      If n = 1 Then ctlData.RowSource = "tblRekDerivatif1"
      If n = 2 Then ctlData.RowSource = "tblRekDerivatif2"
      ctlData.ColumnCount = 2
      ctlData.ColumnWidths = "1440;2880"
      ctlData.ColumnHeads = 1
      ctlData.ListWidth = 1440 + 2880
      ctlData.Format = ""
    Else
      Set ctlData = CreateControl(frm.Name, acTextBox, acDetail, , fld.Name, 1.2833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)
      ctlData.Name = fld.Name
      Set ctlLabel = CreateControl(frm.Name, acLabel, acDetail, ctlData.Name, fld.Name, 0.0833 * 1440, n * 0.2083 * 1440, 1440, 0.2083 * 1440)
      ctlLabel.Name = "lbl" & fld.Name
      ctlData.Format = "Standard"
    End If
    n = n + 1
  Next fld
  DoCmd.Save , "frmImporBudgetSubform"

  DoCmd.Close acForm, "frmImporBudgetSubform", acSaveYes
  DoCmd.SetWarnings True
Exit_Function:
  Exit Function
Err_Msg:
  MsgBox "Error # " & str(Err.Number) & ", source: " & Err.Source & Chr(13) & Err.Description
  Resume Exit_Function
End Function