Skip to main content

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.
'------------------------------------------
' 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

Comments

Posting Terpopuler

Normalisasi, Denormalisasi, dan Anomali Database

Membuat Relasi Database

Menampilkan Data MySQL dalam Form di Access