Membuat Fungsi Untuk Mengatur Properti Field Secara Dinamis pada Sebuah Form

Di MS Access, bila kita membuat form dengan menggunakan sebuah tabel atau query sebagai record sourcenya, maka properti field yang terkait langsung dengan control yang ada di form akan diikutsertakan pada control yang terkait dengan field itu.

Misalnya, properti field name pada tabel akan berkaitan dengan properti control source pada sebuah form. Contoh lainnya:

• Properti input mask field pada tabel akan berkaitan dengan properti input mask pada sebuah form.
• Properti validation rule dan text akan berkaitan dengan properti validation rule dan text pada sebuah form.

Contoh lengkapnya seperti pada gambar di bawah ini.

Gambar 1. Keterkaitan form dengan desain tabel di Access

Pada lingkungan front-end, keterkaitan properti field tabel dengan form control seperti ini sangat diperlukan. Sebagai misal, kita ingin mengubah nilai validasi beserta teks validasi yang ada di dalamnya. Dengan membuat fungsi VBA, kita bisa memanggil nilai validasi dan teks validasi yang ada di field di sebuah tabel untuk ditampilkan di form (pada form control yang terkait dengan field di tabel itu). Jadi untuk mengubah nilai validasi, kita hanya perlu mengubah properti validation value yang ada di field untuk ditampilkan di form control. Cara ini mungkin terasa ribet sekali (kompleks), tetapi akan membantu kelancaran trafik jaringan saat pemasukkan data dari client (front-end) ke server (back-end). Dengan menampilkan nilai validasi di form (front-end), maka proses validasi dilakukan di komputer client (front-end). Bila belum valid, data tidak akan bisa dimasukkan dan disimpan pada sebuah tabel ditempatkan di server (database back-end). Dengan cara ini pula, database menjadi reliable, karena hanya data yang memenuhi syarat saja (data yang valid) yang bisa dimasukkan ke database back-end.

Berikut ini adalah fungsi yang digunakan untuk mengatur properti field secara dinamis pada sebuah form:

view plainprint?

1. Option Compare Database 'Abaikan pernyataan ini bila sudah ada  
2. Public daoDbs As DAO.Database 'Abaikan pernyataan ini bila sudah ada  
3. Public Enum enumProperti  
4.   prpAll = 0  
5.   prpName = 1  
6.   prpTypeGlobal = 2  
7.   prpTypeDetail = 3  
8.   prpSize = 4  
9.   prpDescription = 5  
10.   prpRangeMin = 6  
11.   prpRangeMax = 7  
12.   prpValidationRule = 8  
13.   prpValidationText = 9  
14.   prpDefaultValue = 10  
15.   prpCaption = 11  
16. End Enum  
17. Public Enum enumMinMaks 'Abaikan pernyataan ini bila sudah ada  
18.   angkaMinimum = 1  
19.   angkaMaksimum = 2  
20.   angkaNol = 0  
21. End Enum  
22.   
23. Function arrayTampilkanPropertiField(strNamaFieldArray As String, strNamaTabel As String, Optional intenumProperti As enumProperti) As Variant  
24.   Dim rs As DAO.Recordset  
25.   Dim fld As DAO.Field  
26.   Dim prp As DAO.Property  
27.   Dim boolPrp As Boolean  
28.   Dim strDescription As String, strDefaultValue As String, strValidationRule As String  
29.   Dim strNamaField As String  
30.   Dim varRangeMin, varRangeMax As Variant  
31.   Dim varFieldPropertyArray As Variant  
32. On Error GoTo Err_Msg  
33.   If InStr(1, strNamaFieldArray, ".") <> 0 Then strNamaField = Split(strNamaFieldArray, ".")(1) Else strNamaField = strNamaFieldArray  
34.   Set rs = membukaRecordset(strNamaTabel)  
35.     For Each fld In rs.Fields  
36.       If fld.name = strNamaField Then  
37.             
38.         boolPrp = False  
39.         For Each prp In fld.Properties  
40.           If prp.name = "Description" Then  
41.             boolPrp = True  
42.             Exit For  
43.           End If  
44.         Next prp  
45.         If boolPrp Then  
46.           strDescription = fld.Properties("Description").Value  
47.         Else  
48.           For Each prp In fld.Properties  
49.             If prp.Name = "Caption" Then  
50.               boolPrp = True  
51.               Exit For  
52.             End If  
53.           Next prp  
54.           If boolPrp = True Then  
55.             strDescription = fld.Properties("Caption").Value  
56.           Else  
57.             strDescription = "Properti ini tidak ada/belum diisi"  
58.           End If  
59.         End If  
60.   
61.         boolPrp = False  
62.         For Each prp In fld.Properties  
63.           If prp.Name = "Caption" Then  
64.             boolPrp = True  
65.             Exit For  
66.           End If  
67.         Next prp  
68.         If boolPrp Then  
69.           strCaption = fld.Properties("Caption").Value  
70.         Else  
71.           strCaption = "Properti Caption ini tidak ada/belum diisi"  
72.         End If  
73.                   
74.         boolPrp = False  
75.         For Each prp In fld.Properties  
76.           If prp.name = "DefaultValue" Then  
77.             boolPrp = True  
78.             Exit For  
79.           End If  
80.         Next prp  
81.         If boolPrp Then  
82.           strDefaultValue = fld.Properties("DefaultValue").Value  
83.         Else  
84.           strDefaultValue = vbNullString  
85.         End If  
86.             
87.         boolPrp = False  
88.         For Each prp In fld.Properties  
89.           If prp.name = "ValidationRule" Then  
90.             boolPrp = True  
91.             Exit For  
92.           End If  
93.         Next prp  
94.         If boolPrp Then  
95.           strValidationRule = fld.Properties("ValidationRule").Value  
96.         Else  
97.           strValidationRule = vbNullString  
98.         End If  
99.             
100.         boolPrp = False  
101.         For Each prp In fld.Properties  
102.           If prp.name = "ValidationText" Then  
103.             boolPrp = True  
104.             Exit For  
105.           End If  
106.         Next prp  
107.         If boolPrp Then  
108.           strValidationText = fld.Properties("ValidationText").Value  
109.         Else  
110.           strValidationText = vbNullString  
111.         End If  
112.      
113.         If arrrayTampilkanTipeField(fld.Type)(1) = "Text" Then  
114.           varRangeMin = 0  
115.           varRangeMax = fld.Size  
116.         End If  
117.         If arrrayTampilkanTipeField(fld.Type)(1) = "Memo" Then  
118.           varRangeMin = CVar(rangeMemo)  
119.           varRangeMax = CVar(rangeMemo(angkaMaksimum))  
120.         End If  
121.         If arrrayTampilkanTipeField(fld.Type)(0) = "Numeric" Then  
122.           If arrrayTampilkanTipeField(fld.Type)(1) = "Byte" Then  
123.             varRangeMin = CVar(rangeAngkaByte)  
124.             varRangeMax = CVar(rangeAngkaByte(angkaMaksimum))  
125.           End If  
126.           If arrrayTampilkanTipeField(fld.Type)(1) = "Double" Then  
127.             varRangeMin = CVar(rangeAngkaDouble)  
128.             varRangeMax = CVar(rangeAngkaDouble(angkaMaksimum))  
129.           End If  
130.           If arrrayTampilkanTipeField(fld.Type)(1) = "Single" Then  
131.             varRangeMin = CVar(rangeAngkaSingle)  
132.             varRangeMax = CVar(rangeAngkaSingle(angkaMaksimum))  
133.           End If  
134.           If arrrayTampilkanTipeField(fld.Type)(1) = "Currency" Then  
135.             varRangeMin = CVar(rangeAngkaCurrency)  
136.             varRangeMax = CVar(rangeAngkaCurrency(angkaMaksimum))  
137.           End If  
138.           If arrrayTampilkanTipeField(fld.Type)(1) = "Long Integer" Then  
139.             varRangeMin = CVar(rangeAngkaLong)  
140.             varRangeMax = CVar(rangeAngkaLong(angkaMaksimum))  
141.           End If  
142.           If arrrayTampilkanTipeField(fld.Type)(1) = "Replication Id (GUID)" Then  
143.             varRangeMin = 0  
144.             varRangeMax = 0  
145.           End If  
146.           If arrrayTampilkanTipeField(fld.Type)(1) = "Integer" Then  
147.             varRangeMin = CVar(rangeAngkaInt)  
148.             varRangeMax = CVar(rangeAngkaInt(angkaMaksimum))  
149.           End If  
150.               
151.           If arrrayTampilkanTipeField(fld.Type)(1) = "Decimal" Then  
152.             Dim varDecimalPrp As Variant  
153.             varDecimalPrp = tampilkanPrecisionScaleArrayADO(strNamaField, strNamaTabel)  
154.             varRangeMin = CVar(rangeangkaDecimal)  
155.             varRangeMax = CDec(rangeangkaDecimal(angkaMaksimum, CByte(varDecimalPrp(0)), CByte(varDecimalPrp(1))))  
156.                 
157.           End If  
158.         End If  
159.            
160.         varFieldPropertyArray = Array(fld.name, _  
161.                                       arrrayTampilkanTipeField(fld.Type)(0), _  
162.                                       arrrayTampilkanTipeField(fld.Type)(1), _  
163.                                       fld.Size, _  
164.                                       strDescription, _  
165.                                       Nz(varRangeMin, 0), _  
166.                                       Nz(varRangeMax, 0), _  
167.                                       strValidationRule, _  
168.                                       strValidationText, _  
169.                                       strDefaultValue _  
170.                                      )  
171.         Exit For  
172.       End If  
173.     Next fld  
174.     If intenumProperti = prpAll Then  
175.       arrayTampilkanPropertiField = varFieldPropertyArray  
176.     Else  
177.       arrayTampilkanPropertiField = varFieldPropertyArray(intenumProperti - 1)  
178.     End If  
179.         
180.   Set rs = Nothing  
181. Exit_Function:  
182.   Exit Function  
183. Err_Msg:  
184.      
185.   MsgBox "Function arrayTampilkanPropertiField, Error # " & str(Err.Number) & ", source: " & Err.Source & _  
186.   Chr(13) & Err.Description  
187.   Resume Exit_Function  
188. End Function  
189. Function rangeMemo(Optional intEnumMinMaks As enumMinMaks) As Long  
190.   If intEnumMinMaks = 0 Then rangeMemo = 0  
191.   If intEnumMinMaks = angkaMinimum Then rangeMemo = 0  
192.   If intEnumMinMaks = angkaMaksimum Then rangeMemo = 65400  
193. End Function  

Option Compare Database 'Abaikan pernyataan ini bila sudah ada
Public daoDbs As DAO.Database 'Abaikan pernyataan ini bila sudah ada
Public Enum enumProperti
  prpAll = 0
  prpName = 1
  prpTypeGlobal = 2
  prpTypeDetail = 3
  prpSize = 4
  prpDescription = 5
  prpRangeMin = 6
  prpRangeMax = 7
  prpValidationRule = 8
  prpValidationText = 9
  prpDefaultValue = 10
  prpCaption = 11
End Enum
Public Enum enumMinMaks 'Abaikan pernyataan ini bila sudah ada
  angkaMinimum = 1
  angkaMaksimum = 2
  angkaNol = 0
End Enum

Function arrayTampilkanPropertiField(strNamaFieldArray As String, strNamaTabel As String, Optional intenumProperti As enumProperti) As Variant
  Dim rs As DAO.Recordset
  Dim fld As DAO.Field
  Dim prp As DAO.Property
  Dim boolPrp As Boolean
  Dim strDescription As String, strDefaultValue As String, strValidationRule As String
  Dim strNamaField As String
  Dim varRangeMin, varRangeMax As Variant
  Dim varFieldPropertyArray As Variant
On Error GoTo Err_Msg
  If InStr(1, strNamaFieldArray, ".") <> 0 Then strNamaField = Split(strNamaFieldArray, ".")(1) Else strNamaField = strNamaFieldArray
  Set rs = membukaRecordset(strNamaTabel)
    For Each fld In rs.Fields
      If fld.name = strNamaField Then
          
        boolPrp = False
        For Each prp In fld.Properties
          If prp.name = "Description" Then
            boolPrp = True
            Exit For
          End If
        Next prp
        If boolPrp Then
          strDescription = fld.Properties("Description").Value
        Else
          For Each prp In fld.Properties
            If prp.Name = "Caption" Then
              boolPrp = True
              Exit For
            End If
          Next prp
          If boolPrp = True Then
            strDescription = fld.Properties("Caption").Value
          Else
            strDescription = "Properti ini tidak ada/belum diisi"
          End If
        End If

        boolPrp = False
        For Each prp In fld.Properties
          If prp.Name = "Caption" Then
            boolPrp = True
            Exit For
          End If
        Next prp
        If boolPrp Then
          strCaption = fld.Properties("Caption").Value
        Else
          strCaption = "Properti Caption ini tidak ada/belum diisi"
        End If
                
        boolPrp = False
        For Each prp In fld.Properties
          If prp.name = "DefaultValue" Then
            boolPrp = True
            Exit For
          End If
        Next prp
        If boolPrp Then
          strDefaultValue = fld.Properties("DefaultValue").Value
        Else
          strDefaultValue = vbNullString
        End If
          
        boolPrp = False
        For Each prp In fld.Properties
          If prp.name = "ValidationRule" Then
            boolPrp = True
            Exit For
          End If
        Next prp
        If boolPrp Then
          strValidationRule = fld.Properties("ValidationRule").Value
        Else
          strValidationRule = vbNullString
        End If
          
        boolPrp = False
        For Each prp In fld.Properties
          If prp.name = "ValidationText" Then
            boolPrp = True
            Exit For
          End If
        Next prp
        If boolPrp Then
          strValidationText = fld.Properties("ValidationText").Value
        Else
          strValidationText = vbNullString
        End If
   
        If arrrayTampilkanTipeField(fld.Type)(1) = "Text" Then
          varRangeMin = 0
          varRangeMax = fld.Size
        End If
        If arrrayTampilkanTipeField(fld.Type)(1) = "Memo" Then
          varRangeMin = CVar(rangeMemo)
          varRangeMax = CVar(rangeMemo(angkaMaksimum))
        End If
        If arrrayTampilkanTipeField(fld.Type)(0) = "Numeric" Then
          If arrrayTampilkanTipeField(fld.Type)(1) = "Byte" Then
            varRangeMin = CVar(rangeAngkaByte)
            varRangeMax = CVar(rangeAngkaByte(angkaMaksimum))
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Double" Then
            varRangeMin = CVar(rangeAngkaDouble)
            varRangeMax = CVar(rangeAngkaDouble(angkaMaksimum))
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Single" Then
            varRangeMin = CVar(rangeAngkaSingle)
            varRangeMax = CVar(rangeAngkaSingle(angkaMaksimum))
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Currency" Then
            varRangeMin = CVar(rangeAngkaCurrency)
            varRangeMax = CVar(rangeAngkaCurrency(angkaMaksimum))
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Long Integer" Then
            varRangeMin = CVar(rangeAngkaLong)
            varRangeMax = CVar(rangeAngkaLong(angkaMaksimum))
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Replication Id (GUID)" Then
            varRangeMin = 0
            varRangeMax = 0
          End If
          If arrrayTampilkanTipeField(fld.Type)(1) = "Integer" Then
            varRangeMin = CVar(rangeAngkaInt)
            varRangeMax = CVar(rangeAngkaInt(angkaMaksimum))
          End If
            
          If arrrayTampilkanTipeField(fld.Type)(1) = "Decimal" Then
            Dim varDecimalPrp As Variant
            varDecimalPrp = tampilkanPrecisionScaleArrayADO(strNamaField, strNamaTabel)
            varRangeMin = CVar(rangeangkaDecimal)
            varRangeMax = CDec(rangeangkaDecimal(angkaMaksimum, CByte(varDecimalPrp(0)), CByte(varDecimalPrp(1))))
              
          End If
        End If
         
        varFieldPropertyArray = Array(fld.name, _
                                      arrrayTampilkanTipeField(fld.Type)(0), _
                                      arrrayTampilkanTipeField(fld.Type)(1), _
                                      fld.Size, _
                                      strDescription, _
                                      Nz(varRangeMin, 0), _
                                      Nz(varRangeMax, 0), _
                                      strValidationRule, _
                                      strValidationText, _
                                      strDefaultValue _
                                     )
        Exit For
      End If
    Next fld
    If intenumProperti = prpAll Then
      arrayTampilkanPropertiField = varFieldPropertyArray
    Else
      arrayTampilkanPropertiField = varFieldPropertyArray(intenumProperti - 1)
    End If
      
  Set rs = Nothing
Exit_Function:
  Exit Function
Err_Msg:
   
  MsgBox "Function arrayTampilkanPropertiField, Error # " & str(Err.Number) & ", source: " & Err.Source & _
  Chr(13) & Err.Description
  Resume Exit_Function
End Function
Function rangeMemo(Optional intEnumMinMaks As enumMinMaks) As Long
  If intEnumMinMaks = 0 Then rangeMemo = 0
  If intEnumMinMaks = angkaMinimum Then rangeMemo = 0
  If intEnumMinMaks = angkaMaksimum Then rangeMemo = 65400
End Function

Fungsi di atas melibatkan berbagai macam fungsi yang telah dibuat di posting terdahulu. Berbagai macam fungsi itu adalah sebagai berikut:

1. membukaRecordset untuk membuka recordset
2. arrrayTampilkanTipeField untuk menampilkan tipe field
3. rangeMemo untuk menampilkan size dari tipe data Memo
4. rangeAngkaByte untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Byte
5. rangeAngkDouble untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Double
6. rangeAngkaSingle untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Single
7. rangeAngkaCurrency untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Currency
8. rangeAngkaLong untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Long Integer
9. rangeAngkaInt untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Integer
10. rangeAngkaDecimal untuk menampilkan size minimum dan maksimum dari field dengan tipe data number dan size Decimal
11. tampilkanPrecisionScaleArrayADO untuk menampilkan properti Precision dan Scale dari tipe data number dan size Decimal.

Implementasi

Berikut ini adalah contoh aplikasi fungsi arrayTampilkanPropertiField:

view plainprint?

1. ?membukaDbs  
2.   
3. ?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpDescription)  
4. Nama atau deskripsi rekening  
5.   
6. ?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpSize)  
7.  100   
8.   
9. ?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpTypeDetail)  
10. Text  

?membukaDbs

?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpDescription)
Nama atau deskripsi rekening

?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpSize)
 100 

?arrayTampilkanPropertiField("NamaRek","tblRekUtama",prpTypeDetail)
Text

Gambar di bawah ini mungkin dapat menjelaskan jalannya fungsi di atas. Kotak Immediate pada gambar adalah cuplikan dari Immmediate Window (berada di front-end), sedangkan kotak di latar belakang adalah Design View dari tabel tblRekUtama yang ada di database back-end bernama Akunting.accdb.

Gambar 2. Immediate Window membaca properti field tabel

Database back-end ini posisinya benar-benar terpisah dari front-end. Dengan mengacu pada penjelasan seperti di gambar 1 di atas, kita bisa mengaplikasikan fungsi arrayTampilkanPropertiField di sebuah form saat form dibuka (menggunakan event On Open). Kita hanya perlu memasukkan properti form control yang berkaitan (atau sama) dengan nama field sebuah tabel. Dengan cara ini, untuk mengubah properti form control, kita hanya perlu mengubah properti field pada sebuah tabel, tanpa perlu mengubah satu per satu properti field yang ada di form control, yang tentu saja melelahkan. Fungsi arrayTampilkanPropertiField akan mengaturnya secara dinamis, bila properti field di tabel diubah, maka properti form control yang berkaitan dengan field tabel ini juga akan berubah.

Terakhir, kita bisa saja menambahkan berbagai macam nilai pada Public Enum enumProperti di fungsi di atas. Jadi, silakan bereksperimen sendiri.