VBA have several predefined data types like Integer, String, Date and so on to use in Programs. These can be used to hold only one type of data in them. Integer Variable can hold Numeric Values ranging from -32768 to +32767 and String Type stores Alpha-Numeric Values and so on.
But, Programmers can define their own data Type with a mix of all these predefined data types and use it in their programs. We are going to try this out with a simple example.
- Open one of your existing databases or create a new one.
- Open the VBA Editing Window (Alt+F11 or Tools- ->Macro – -> VBA Editing)
Access2007:
- Select Modules from the Objects dropdown list
- Double-click on an existing Module or select Create Menu.
- Select Macro- ->Modules Toolbar button to create a new Standard Module.
- Copy and paste the following Code into the Module.
Public Type WagesRec strName As String dblGrossPay As Double dblTaxRate As Double dblNetPay As Double booTaxPaid As Boolean End Type Public Function WagesCalc() Dim netWages As WagesRec, strMsg As String Dim fmt As String With netWages .strName = InputBox("Employee Name: ", , "") .dblGrossPay = InputBox("Enter Gross Pay:", , 0) .dblTaxRate = InputBox("Enter Taxrate", , 0) .dblNetPay = .dblGrossPay - (.dblGrossPay * .dblTaxRate) If .dblTaxRate <> 0 Then .booTaxPaid = True End If 'Display Record fmt = "#,##0.00" strMsg = "Name: " & .strName & vbCr & "Grosspay: " & Format(.dblGrossPay, fmt) & vbCr strMsg = strMsg & "Tax Rate: " & Format(.dblTaxRate * 100, fmt) & "%" & vbCr & "Tax Amt.: " & Format(.dblGrossPay * .dblTaxRate, fmt) & vbCr strMsg = strMsg & "Net Pay: " & Format(.dblNetPay, fmt) & vbCr & "Tax Paid: " & .booTaxPaid MsgBox strMsg, , "WagesCalc()" End With End Function - Place the insertion point somewhere in the middle of the WagesCalc() Function and press F5 Key to run the Code.
- Key in name of the Employee, Gross Pay and Tax Rate Values when prompted for them.
The output display of the program is shown below:
Let us examine the above Code. The User defined data type declaration is made at the global area of a Standard Module within the Type WagesRec. . .End Type structure. WagesRec is an arbitrary name; it can be anything that you like but it should follow the Variable naming conventions. By default the scope of the data type is Public i.e. we can declare a variable using the new data type in Standard Modules and Class Modules as well. When it is declared as Private; like Private Type WagesRec. . .End Type the scope of the data type is within that module only.
The individual element's name of the new data type should also follow the normal variable naming conventions.
We have declared a Variable NetWages (you can take NetWages as an Object having several properties that can be set with values) using the new data type WagesRec in our WagesCalc() Function. Individual elements of the NetWages Variable can be addressed as a subset of that object; both separating with a dot (.) like Netwages.dblGrossPay to set its value or retrieve its contents.
We have used three InputBox statements to ask the user to input values for Name, Grosspay, Tax Rate and calculate the Tax Value, Net Payable amount and set the Tax Paid flag, if Tax Rate is a non-zero value.
Next part of the program we have loaded a String Variable strMsg with the output labels and values to display them through a MsgBox.
In the above Type declaration example we have used the predefined System data types as elements. Besides that we can declare Subscripted Elements and other User-Defined Data Type also as elements, like the following example:
Public Type MyRecord
dblIncentives(1 to 100) as double
EmployeeRec as WagesRec
End Type
In our program let us assume that we have declared a variable with the above data type like the following:
Dim EmployeeWages as MyRecord
Addressing the individual elements and their sub-elements will be as follows to assign values into them:
EmployeeWages.dblIncentives(1) = 5000
EmployeeWages.EmployeeRec.strName = "John Smith"
But the whole Data Type can be declared as a Subscripted Variable like:
Dim EmployeeWages(1 to 100) as MyRecord
Then how we will address the individual elements of the Variable?
EmployeeWages(1).dblIncentives(1) = 500
EmployeeWages(1).dblIncentives(2) = 750
EmployeeWages(1).EmployeeRec.strName = "John Smith"
EmployeeWages(1).EmployeeRec.dblGrossPay = 15000
.
.EmployeeWages(2).dblIncentives(1) = 400
EmployeeWages(2).dblIncentives(2) = 450
EmployeeWages(2).EmployeeRec.strName = "George"
EmployeeWages(2).EmployeeRec.dblGrossPay = 17000
.
.
We will see another example that uses subscripted user-defined data type. In this example we will declare a new Data Type for the Employees Table from the Northwind.mdb sample database. We will load few field values of the Employees Table into our User Defined Subscripted Variable, sort the Names in memory and print the output into the Debug Window.
1. Import the Employees Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample database.
2. Copy and Paste the following VBA Code into a new Standard Module and save the Module:
Type PersonalRecord
strFirstName As String
strLastName As String
dtDB As Date
strAddress As String
strCity As String
strPostalCode As String
End Type
Public Function ReadSort()
Dim PRec() As PersonalRecord, PRecX As PersonalRecord
Dim db As Database, rst As Recordset, recCount As Long
Dim J As Long, k As Long, h As Long
Set db = CurrentDb
Set rst = db.OpenRecordset("Employees", dbOpenDynaset)
rst.MoveLast
recCount = rst.RecordCount
ReDim PRec(1 To recCount) As PersonalRecord
rst.MoveFirst
J = 0
'Load Employee Records into Userdefined Variable Array
Do While Not rst.EOF
J = J + 1
With rst
PRec(J).strFirstName = ![FirstName]
PRec(J).strLastName = ![LastName]
PRec(J).dtDB = ![BirthDate]
PRec(J).strAddress = ![Address]
PRec(J).strCity = ![City]
PRec(J).strPostalCode = ![PostalCode]
End With
rst.MoveNext
Loop
rst.Close
Debug.Print "Before Sorting"
Debug.Print "--------------"
DisplayRoutine PRec()
'Bubble Sort on FirstName
For k = 1 To J - 1
For h = k + 1 To J
If PRec(h).strFirstName < PRec(k).strFirstName Then
'Swap the Records
'move the first record to temporary storage area
PRecX.strFirstName = PRec(k).strFirstName
PRecX.strLastName = PRec(k).strLastName
PRecX.dtDB = PRec(k).dtDB
PRecX.strAddress = PRec(k).strAddress
PRecX.strCity = PRec(k).strCity
PRecX.strPostalCode = PRec(k).strPostalCode
'move the second record to replace the first
PRec(k).strFirstName = PRec(h).strFirstName
PRec(k).strLastName = PRec(h).strLastName
PRec(k).dtDB = PRec(h).dtDB
PRec(k).strAddress = PRec(h).strAddress
PRec(k).strCity = PRec(h).strCity
PRec(k).strPostalCode = PRec(h).strPostalCode
'move the from temporary storage to replace the second record
PRec(h).strFirstName = PRecX.strFirstName
PRec(h).strLastName = PRecX.strLastName
PRec(h).dtDB = PRecX.dtDB
PRec(h).strAddress = PRecX.strAddress
PRec(h).strCity = PRecX.strCity
PRec(h).strPostalCode = PRecX.strPostalCode
End If
Next h
Next k
Debug.Print "After Sorting"
Debug.Print "--------------"
DisplayRoutine PRec()
End Function
Public Function DisplayRoutine(ByRef getRecord() As PersonalRecord)
Dim RecordCount As Long, J As Long
RecordCount = UBound(getRecord)
For J = 1 To RecordCount
Debug.Print getRecord(J).strFirstName, getRecord(J).strLastName, getRecord(J).dtDB
Next
Debug.Print
Debug.Print
End Function
3. Place the insertion point in the middle of the Module and press F5 to run the Code.
4. Press Ctrl+G to display the Debug Window and you will find the following output printed there:
Before Sorting -------------- Nancy Davolio 08/09/1968 Andrew Fuller 19/02/1952 Janet Leverling 30/08/1963 Margaret Peacock 19/09/1958 Steven Buchanan 04/03/1955 Michael Suyama 02/07/1963 Robert King 29/05/1960 Laura Callahan 09/01/1958 Anne Dodsworth 02/07/1969 After Sorting -------------- Andrew Fuller 19/02/1952 Anne Dodsworth 02/07/1969 Janet Leverling 30/08/1963 Laura Callahan 09/01/1958 Margaret Peacock 19/09/1958 Michael Suyama 02/07/1963 Nancy Davolio 08/09/1968 Robert King 29/05/1960 Steven Buchanan 04/03/1955
- At the beginning part of the program we have opened the Employees Table, read the count of records in the Table and accordingly we have re-dimensioned the user-defined variable PersonalRecord to reserve enough space to hold all the Employees record.
- Next we have opened the Employees Table and loaded all the employees data into the array.
- We have sent a listing of the unsorted data into the Debug Window.
- The data is sorted in Ascending Order on FirstName in memory using the Bubble-Sort method.
- The sorted employee records are listed in the Debug Window again.
Tip: You can change the sorting order in Descending order by changing the logical operator < to > in the following statement:
If PRec(h).strFirstName < PRec(k).strFirstName Thento
If PRec(h).strFirstName > PRec(k).strFirstName Then
As you can see, the data printing Routine is a separate Function Display Routine() and we have passed the whole Array of records to this program twice to print its contents into the Debug Window.
Users Group and Permissions
Creating User Account with VBA
Microsoft Date/Time Picker Control
Form and Report Open Arguments
Download Free Software:Desktop Utilities, Mobile Communication, Games etc.
