Ten Tips for Microsoft Access Developers

  • Article

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.

 

Frank C. Rice
Microsoft Corporation

July 2002

Applies to:
    Microsoft® Access 2002

Summary: Learn Access programming tips such as displaying a range of dates in a Calendar control, creating a blinking label prompt for a text box, converting a number from one base to another, and more. (39 print pages)

Contents

Display a Range of Dates in a Calendar Control
Calculate a Person's Age in Years or Months
Change the Label of a Control when an Option is Clicked
Create a Blinking Label Prompt for a Text Box
Prevent the Accidental Erasure of Data when Moving between Controls on a Form
Display Updated Data in a Report Opened from a Form
Populate Form Fields Based on a Combo Box Selection
Calculate the Exact Difference between Two Dates
Convert a Number from One Base to Another
Convert Numbers to Text

Display a Range of Dates in a Calendar Control

The Calendar ActiveX® control doesn't support selecting a range of dates. However, with just a few lines of code, you can display a range of dates from the Calendar control in your form. To see how, do the following:

  1. Start Microsoft Access 2002 and open a new form in Design view.

  2. Click the More Controls button in the Toolbox (available from the View menu), click the Calendar Control 10.0, and then click on the form to place the control.

  3. Click a Text Box control in the Toolbox, and then click on the form to place the control.

  4. Double-click the text box and in the Name property under the All tab, type txtRange.

  5. Click a Text Box control in the Toolbox, and then click on the form to place a second control.

  6. Double-click the text box you just added, and in the Name property under the All tab, type txtStartDate.

  7. Click a Text Box control in the Toolbox again, and then click on the form to place the third control.

  8. Double-click the text box you just added, and in the Name property under the All tab, type txtEndDate.

  9. Click the Command Button tool in the Toolbox, and then click on the form to place the control.

  10. In the Command Button Wizard, click Cancel. Double-click the command button and then click the Event tab. Next, click the On Click event, click Code Builder, and then click OK.

  11. Insert the following code into the subroutine and then close the Visual Basic Editor:

    Dim dt As Date
Dim intRange As Integer

dt = Me!Calendar0.Value
intRange = Me!txtRange.Value
Me!txtStartDate = dt
Me!txtEndDate = DateAdd("d", intRange, dt)

  12. Open the form in Form view (see Figure 1), and then click a date in the Calendar control.

    Aa139962.odc_actips01(en-us,office.10).gif

    Figure 1. Form with Calendar control.

  13. Next, type a range, such as 5 or -5, into the txtRange text box, and then click the button. Notice that the txtStartDate text box displays the day that you clicked in the calendar and the txtEndDate text box contains a date that is offset by the number of days you typed into the txtRange text box.

Note   Use a positive number as the range to indicate an end date that is ahead of the start date. A negative number results in an end date that is before the start date.

Calculate a Person's Age in Years or Months

The Age function described in this section can be used to calculate a person's age, in years and (optionally) in months, and return the age with descriptive text.

Note This function was contributed by, and is used with the permission of, Graham R. Seach, Microsoft Access Most Valued Professional (MVP).

To illustrate using the function, we will first create an Access form with two text boxes; one where you enter a birth date, and one which displays the value returned by the Age function. The form will also contain check boxes which let you select whether you want to include months with the age, and whether you want descriptive text included in the display. Do the following:

  1. Start Access and open a new form in Design view.

  2. Click a Text Box control in the Toolbox (available from the View menu), and then click on the form to place the control.

  3. Double-click the text box, and in the Name property under the All tab, type txtDOB.

  4. Click in the Format property, click the arrow, and then click Short Date.

  5. Click in the Input Mask property, click the build button (the ellipses**…**), scroll through the list of input mask examples, and then click Short Date. Click Finish.

    Note Setting the Input Mask property, as we did in the previous step, insures that the date we pass to the

    Age

    function is formatted as a Short Date (mm/dd/yyyy). If you use the

    Age

    function in your own custom application, it is a good idea to always check to make sure the date you pass to the function is formatted correctly.

  6. Click the Format tab, scroll down, click in the Text Align property, and then click Left.

  7. Click the text box’s label, and in the Caption property under the All tab, type Date of Birth.

  8. Click a Check Box control on the Toolbox, and then click on the form to place the control.

  9. Double-click the control, and in the Name property, type ckMonths.

  10. In the Default Value property, type 0. This sets the control as clear (unchecked) when the form is displayed.

  11. Click the check box’s label, and in the Caption property, type Include months?.

  12. Click another Check Box control on the Toolbox, and then click on the form to place the control.

  13. Double-click the control, and in the Name property, type ckText.

  14. In the Default Value property, type 0.

  15. Click the check box’s label, and in the Caption property, type Display age with text?.

  16. Click the Command Button tool in the Toolbox, and then click on the form to place the control.

  17. In the Command Button Wizard, click Cancel. Double-click the command button and then click the Event tab. Next, click the On Click event, click Code Builder, and then click OK.

  18. Insert the following code into the subroutine:

        Dim varAge As Variant
    Dim dtDOB As Date
    Dim dtCurrentDate As Date
    Dim bolMonths As Boolean
    Dim bolText As Boolean

    dtCurrentDate = FormatDateTime(Now(), vbShortDate)

    Me![txtDOB].SetFocus
    dtDOB = Me![txtDOB].Value

    Me![ckMonths].SetFocus
    If Me![ckMonths].Value Then
        bolMonths = True
    Else
        bolMonths = False
    End If

    Me![ckText].SetFocus
    If Me![ckText].Value Then
        bolText = True
    Else
        bolText = False
    End If
    varAge = Age(dtDOB, dtCurrentDate, bolMonths, bolText)
    Me![txtAge].SetFocus
    Me![txtAge].Value = varAge

After setting the appropriate variables, the procedure formats the current date (used by the Age function as the basis for calculating the birth date) into a Short Date by using the FormatDateTime function. We then get the date of birth, check to see if the txtMonths and txtText check boxes are selected, and then call the Age function. And finally, we display the value returned by the function in the txtAge text box.

  1. While still in the Visual Basic Editor, on the Insert menu, click Module.

  2. In the code window, insert the Age function:

    Public Function Age(DOB As Date, today As Date, Optional WithMonths As Boolean = False, _
             Optional WithDays As Boolean = False, Optional DisplayWithWords As Boolean = False) As Variant
   'Author: © Copyright 2001 Pacific Database Pty Limited
   ' Graham R Seach gseach@pacificdb.com.au
   ' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
   '
   ' You may freely use and distribute this code
   ' with any applications you may develop, on the
   ' condition that the copyright notice remains
   ' unchanged, and intact as part of the code. You
   ' may not sell or publish this code in any form
   ' without the express written permission of the
   ' copyright holder.
   '
   ' Description: This function calculates a person's age,
   ' given their date of birth, and a second date.
   '
   ' Inputs: DOB: The person's date of birth
   ' Today: The second date (ostensibly today)
   ' WithMonths: Boolean - If True, displays months
   ' DisplayWithWords: Boolean - If True, displays
   ' (ie: years / months)
   '
   ' Outputs: On error: Null
   ' On no error: Variant containing person's age in
   ' years, months and days (if selected).
   ' If DisplayWithWords = False:
   ' Months and days, if selected, are shown
   ' to the right of the decimal point, but
   ' are the actual number of months and days,
   ' not a fraction of the year. For example,
   ' 44.11.03 = 44 years 11 months and 3 days.
   ' If DisplayWithWords = True:
   ' Output example: "44 years 11 months 3 days",
   ' except where months = 0, in which case, no
   ' months are shown.
            
   On Error GoTo Age_ErrorHandler
            
   Dim iYears As Integer
   Dim iMonths As Integer
   Dim iDays As Integer
   Dim dTempDate As Date
            
   ' Check that the dates are valid
   If Not (IsDate(DOB)) Or Not (IsDate(today)) Then
      DoCmd.Beep
      MsgBox "Invalid date.", vbOKOnly + vbInformation, "Invalid date"
      Exit Function
   End If
            
   ' Check that DOB < Today
   If DOB < today Then
      DoCmd.Beep
      MsgBox "Today must be greater than DOB.", _
         vbOKOnly + vbInformation, "Invalid date position"
      GoTo Age_ErrorHandler
   End If
            
   iYears = lAge = Abs(DateDiff("yyyy", dteDate1, dteDate2) - _
      IIf(Format(dteDate1, "mmdd") <= Format(dteDate2, "mmdd"), 0, 1)) 
   dTempDate = DateAdd("yyyy", iYears, DOB)
            
   If WithMonths Then
      iMonths = DateDiff("m", dTempDate, today) - _
         IIf(DateAdd("m", iMonths, DateAdd("yyyy", iYears, DOB)) > today, 1, 0)
      dTempDate = DateAdd("m", iMonths, dTempDate)
   End If
            
   If WithDays Then
      iDays = today - dTempDate
   End If
            
   ' Format the output
   If DisplayWithWords Then
      ' Display the output in words
      Age = IIf(iYears > 0, iYears & " year" & IIf(iYears <> 1, "s", ""), "")
      Age = Age & IIf(WithMonths, iMonths & " month" & IIf(iMonths <> 1, "s", ""), "")
      Age = Trim(Age & IIf(WithDays, iDays & " day" & IIf(iDays <> 1, "s", ""), ""))
   Else
      ' Display the output in the format yy.mm.dd
      Age = Trim(iYears & IIf(WithMonths, "." & Format(iMonths, "00"), "") _
      & IIf(WithDays, "." & Format(iDays, "00"), ""))
   End If
            
   Exit_Age:
      Exit Function
 
   Age_ErrorHandler:
      Age = Null
End Function

  3. Close the Visual Basic Editor.

  4. Double-click the command button, and in the Caption property, type Get Your Age.

  5. Click a Text Box control in the Toolbox, and then click on the form to place the control below the command button.

  6. Double-click the text box and in the Name property, type txtAge.

  7. Click the text box’s label, and in the Caption property, type Age.

  8. Open the form in Form view. Type your birth date into the Date of birth text box, and then click the command button. Your age is displayed in the Age text box.

  9. Select the Include months? and the Display age with text? check boxes, and then click the button. Your age, in years and months, is displayed in the Age text box, annotated with text (see Figure 2).

    Aa139962.odc_actips02(en-us,office.10).gif

    Figure 2. Form with age displayed.

Change the Label of a Control when an Option is Clicked

You can change the label of an option group or another control on a form whenever the user clicks an option. For example, say that you have a search form that allows users to search a table for records by product name or part number. The user enters the name or number in a text box, and then clicks a search button. You can add an option group to the form where the user selects the type of search and, based on the selection, display the appropriate label over the text box. To see this in action, do the following:

  1. Start Access and open a new form in Design view.

  2. Click the Option Group control in the Toolbox and then click on the form to place the control.

  3. In the Option Group Wizard, type Part Number in the first line under the Label Names box. Type Product Name into the next line. Click Next.

  4. In the next screen, leave the default as Part Number, and then click Next.

  5. In the next screen, leave the values assigned as 1 for Part Number and 2 for Product Name. Click Next.

  6. In the next screen, choose the Option buttons option, and then click Next.

  7. In the next screen, type fraMyFrame for the name of the control, and then click Finish.

  8. Double-click the option group frame you just added to the form to display the property sheet.

  9. Click the Event tab, click the After Update event, click the build button (with ellipses**…**), click Code Builder, and then click OK.

  10. Insert the following code into the subroutine and then close the Visual Basic Editor:

    If Me!fraMyFrame = 1 Then
    Me!lblMyLabel.Caption = "Enter the part number"
Else
    Me!lblMyLabel.Caption = "Enter the product name"
End If

  11. Click a Text Box control in the Toolbox and then click on the form to place the control. Drag the text box label to the top of the text box so that it is parallel to the text box and then resize both the text box and the label until they are approximately 2 inches in width.

  12. Double-click the text box label and in the Name property under the All tab, type lblMyLabel. Close the property sheet.

  13. Display the form in Form view, and then click Part Number in the option group. Notice that the label over the text box changes to Enter the part number (see Figure 3).

    Aa139962.odc_actips03(en-us,office.10).gif

    Figure 3. Form with changing label.

  14. Click Product Name in the option group. Notice that the label over the text box changes to Enter a product name.

Create a Blinking Label Prompt for a Text Box

You can change the font color of a Label control on a form so that the label appears to blink. This permits you to call attention to the control or an area of the form. For example, say that you have a data entry form and you want to call attention to a particular text box so that users will enter some critical information. You can use the form's Timer event to change the color of the label's text font to a blink at a specific interval. To see this in action, do the following:

  1. Start Access and open a new form in Design view.

  2. Click a Text Box control in the Toolbox and then click on the form to place the control.

  3. Double-click the label for the text box and in the Name property under the All tab, type lblMyLabel. Type Blinker in the Caption property. Close the property sheet.

  4. Open the property sheet for the form, and click the Event tab.

  5. In the Timer Interval box type 500. This value determines the blink rate.

  6. Click the On Timer event, click the build button (with ellipses…), click Code Builder, and then click OK.

  7. Insert the following code into the subroutine, and then close the Visual Basic Editor:

    With lblMyLabel
    .ForeColor = (IIf(.ForeColor = 0, 255, 0))
End With

  8. Display the form in Form view. Notice that the label over the text box blinks (see Figure 4).

    Aa139962.odc_actips04(en-us,office.10).gif

    Figure 4. Form with blinking label.

Prevent the Accidental Erasure of Data when Moving between Controls on a Form

When you tab from one text box or memo field to another in a form, the text in the control is highlighted. This makes it easy for users to accidentally delete the text by pressing a key. By using a few lines of code, you can move the insertion point to a specific position in the text box, eliminating the risk of accidentally deleting the text. To see how, perform the following steps. The code used in this procedure was contributed by Arvin Meyer, Microsoft Access MVP, and taken from a posting to the Access newsgroup (microsoft.public.access.formscoding):

  1. Start Access and open a new form in Design view.

  2. Click a Text Box control in the Toolbox, and then click on the form to place the control.

  3. Click another Text Box control in the Toolbox, and then click on the form to place a second control.

  4. Double-click the text box you just added and in the Name property under the All tab, type txtMyTextbox.

  5. While still in the property sheet, click the Event tab, click the On Got Focus event, click the build button (with ellipses…), click Code Builder, and then click OK.

  6. Insert the following code into the subroutine, and then close the Visual Basic Editor:

    Me.txtMyTextBox.SelLength = Me.txtMyTextBox.SelStart

  7. Display the form in Form view. Type some text into each of the text boxes.

  8. Press the TAB key to move from one text box to the other. Notice that when the cursor lands in the text box without the code, all of the text is highlighted (the top view in Figure 5). When the cursor lands in the other text box, the cursor is positioned at the beginning of the text (the bottom view in Figure 5).

    Aa139962.odc_actips05(en-us,office.10).gif

    Figure 5. Form with modified tab behavior.

Display Updated Data in a Report Opened from a Form

Let's assume that you have a form and a report based on the same table or query. You change the data in the form and then click a button on the form to open the report. You expect to see the data in the report reflect the change but the report displays the old data. You can remedy this easily with only a few lines of code. To see how, perform the following steps. The code in this tip was contributed by John Spencer, Microsoft Access MVP, and taken from a posting in the Access newsgroup (microsoft.public.access.formscoding):

  1. Start Access and open a new table in Design view.

  2. Add one field to the table, keeping the default name as Field1, and then close and save the table with the default name of Table1.

  3. Open the table and type Hello in the field.

  4. In the Database window, click Reports under Objects.

  5. Click the New button on the Database window toolbar.

  6. In the New Report dialog box, click Design View.

  7. Click Table1 in the drop-down list, and then click OK.

  8. From the Field List box (View menu), click and drag Field1 onto the report.

  9. Close and save the report with the default name of Report1.

  10. In the Database window, click Forms under Objects.

  11. Click the New button on the Database window toolbar.

  12. In the New Form dialog box, click Design View.

  13. Click Table1 in the drop-down list, and then click OK.

  14. In the Field List box (View menu, click Field List), click and drag Field1 onto the form.

  15. In the Toolbox (View menu, click Toolbox), click the Command Button tool, and then click on the form to place the control.

  16. In the Command Button Wizard, click Report Operations in the Categories box, click Preview Report in the Actions box, and then click Next.

  17. In the next screen, click Report1, and then click Next.

  18. In the next screen, click the Text option, and then click Finish.

  19. Display the form in Form view, and then click the button to open the report. Notice that the text box in the report displays the text Hello. Close the report.

  20. Change the text in the text box on the form to Goodbye, and then click the button to open the report. Notice that the text box in the report still displays the text Hello. Close the report.

  21. Open the form in Design view, and then double-click the command button to display the property sheet. Click on Event tab, click the On Click event, and then click the build button (with ellipses**…**).

  22. Insert the following code into the subroutine just after the Dim statement, and then close the Visual Basic Editor:

    If Me.Dirty = True Then
    Me.Dirty = False
End If

  23. Open the form in Form view. The text box still contains the text Goodbye (see top view of Figure 6). Click the button to open the report. Notice that the text box in the report now displays Goodbye (see bottom view of Figure 6).

    Aa139962.odc_actips06(en-us,office.10).gif

    Figure 6. Form and corresponding report.

Setting the Dirty property from True to False saves the record before the report is opened. When the report opens, it displays the current text.

Populate Form Fields Based on a Combo Box Selection

A common task for people who use forms is to populate text boxes when the user makes a selection from a combo box. An easy way to do this is to include all of the field values into the row of the combo box and assign them to the text boxes when the user makes a selection. To see how this is done, perform the following steps. The code in this tip came from Doug Steele, Microsoft Access MVP, and was taken from a posting in the Access newsgroup (microsoft.public.access.formscoding):

  1. Start Access and open a new table in Design view.

  2. Add the following fields (with data types) to the table:

    Field Name Data Type
    CustID AutoNumber
    Name Text
    Address Text
    City Text
    State Text
    ZipCode Text
    Phone Text

  3. Close and save the table as tblCustomers.

  4. Reopen the table, type the following data into each field, and then close the table:

    Field Name Data
    Name Nancy Davolio
    Address 123 Any Place
    City Seattle
    State WA
    ZipCode 98053
    Phone 123-4567

  5. In the Database window, click Forms under Objects.

  6. Click the New button on the Database window toolbar.

  7. In the New Form dialog box, click Design View, and then click OK.

  8. Click a Combo Box control in the Toolbox, and then click on the form to place the control.

  9. In the Combo Box Wizard, click the I want the combo box to look up the values in a table or query option, and then click Next.

  10. In the next screen, click the tblCustomers table, and then click Next.

  11. In the next screen, copy all of the fields to the Selected Fields box, and then click Next.

  12. In the next screen, for each field except the Name field, position the mouse on the right side of the field label until the cursor displays double arrows, click, and then move the mouse to the left until the column is no longer visible. You should end up with just the Name column visible in the screen. Click Next.

  13. Type cboCustomer as the name of the control, and then click Finish.

  14. Double-click the combo box to display the property sheet. Click on Event tab, click the AfterUpdate event, and then click the build button (with ellipses**…**).

  15. Insert the following code into the subroutine, and then close the Visual Basic Editor:

    Me.txtName.Value = Me.cboCustomer.Column(1)
Me.txtAddress.Value = Me.cboCustomer.Column(2)
Me.txtCity.Value = Me.cboCustomer.Column(3)
Me.txtState.Value = Me.cboCustomer.Column(4)
Me.txtZipCode.Value = Me.cboCustomer.Column(5)
Me.txtPhone.Value = Me.cboCustomer.Column(6)

  16. Click a Text Box control in the Toolbox, and then click on the form to place the control.

  17. Double-click the text box you just added and in the Name property under the All tab, type txtName.

  18. Repeat the two previous steps and add five additional text boxes to the form, substituting the following values for the text box name:

    txtAddress

    txtCity

    txtState

    txtZipCode

    txtPhone

  19. Open the form in Form view. Click the drop-down arrow in the combo box and then click Nancy Davolio. The text boxes are populated with the information in the record (see Figure 7).

    Aa139962.odc_actips07(en-us,office.10).gif

    Figure 7. Populate text boxes from a combo box selection.

Calculate the Exact Difference between Two Dates

You can used the Diff2Dates function illustrated in this section to calculate the precise difference between two dates, in years, months, days, hours, minutes and seconds, and return the difference as text.

Note The

Diff2Dates

function was contributed by, and is used with the permission of, Graham R. Seach, Microsoft Access MVP.

To illustrate using the function, we will first create an Access form with three text boxes; one for the first date, one for the second date, and one for the return value. The form will also contain check boxes, which allow you to select the interval of the return, and a command button to execute the subroutine which calls the Diff2Dates function. Do the following:

  1. Start Access and open a new form in Design view.

  2. Click the Check Box control in the Toolbox, and then click on the form to place the control. Repeat this step until there are a total of seven check boxes on the form.

  3. Double-click the first check box, and in the Name property, type ckYears.

  4. In the Default Value property, type 0.

  5. Click the check box’s label, and in the Caption property, type Years.

  6. Repeat the three previous steps, substituting the Name and Caption property for those in the following table. Type the Default Value as 0 for each control :

    Name Label
    ckMonths Months
    ckDays Days
    ckHours Hours
    ckMinutes Minutes
    ckSeconds Seconds
    ckZero Display zeroes?

  7. Click a Text Box control in the Toolbox, and then click on the form.

  8. Double-click the text box and in the Name property, type txtDate1.

  9. Click the text box’s label, and in the Caption property, type Date 1.

  10. Click a Text Box control in the Toolbox, and then click on the form.

  11. Double-click the text box and in the Name property, type txtDate2.

  12. Click the text box’s label, and in the Caption property, type Date 2.

  13. Click a Text Box control in the Toolbox, and then click on the form.

  14. Double-click the text box and in the Name property, type txtResult.

  15. Click the text box’s label, and in the Caption property, type Results.

  16. Click the Command Button tool in the Toolbox, and then click on the form to place the control.

  17. In the Command Button Wizard, click Cancel. Double-click the command button and then click the Event tab. Next, click the On Click event, click Code Builder, and then click OK.

  18. Insert the following code into the subroutine:

    Dim strInterval As String
Dim Date1 As Date
Dim Date2 As Date
Dim bolShowZero As Boolean
Dim varDiff As Variant

strInterval = ""

Me![ckYears].SetFocus
If Me![ckYears] Then
    strInterval = "y"
End If
Me![ckMonths].SetFocus
If Me![ckMonths] Then
    strInterval = strInterval & "m"
End If
Me![ckDays].SetFocus
If Me![ckDays] Then
    strInterval = strInterval & "d"
End If
Me![ckHours].SetFocus
If Me![ckHours] Then
    strInterval = strInterval & "h"
End If
Me![ckMinutes].SetFocus
If Me![ckMinutes] Then
    strInterval = strInterval & "n"
End If
Me![ckSeconds].SetFocus
If Me![ckSeconds] Then
    strInterval = strInterval & "s"
End If

Me![ckZero].SetFocus
If Me![ckZero] Then
    bolShowZero = True
End If

Me![txtDate1].SetFocus
If Me![txtDate1].Value <> "" Then
    Date1 = Me![txtDate1].Value
Else
    MsgBox "Please enter a beginning date."
    Exit Sub
End If

Me![txtDate2].SetFocus
If Me![txtDate2].Value <> "" Then
    Date2 = Me![txtDate2].Value
Else
    MsgBox "Please enter an end date."
    Exit Sub
End If

varDiff = Diff2Dates(strInterval, Date1, Date2, bolShowZero)

Me![txtResult].SetFocus
Me![txtResult].Value = varDiff

  19. While still in the Visual Basic Editor, on the Insert menu, click Module.

  20. In the code window, insert the Diff2Dates function:

    Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _
    Optional ShowZero As Boolean = False) As Variant
    ' Author:    ©Copyright 2001 Pacific Database Pty Limited
    '           Graham R Seach MCP MVP gseach@pacificdb.com.au
    '           Phone: +61 2 9872 9594  Fax: +61 2 9872 9593
    '           (*) Amendments suggested by Douglas J. Steele MVP
    '
    '           You may freely use and distribute this code
    '           with any applications you may develop, on the
    '           condition that the copyright notice remains
    '           unchanged, and intact as part of the code. You
    '           may not sell or publish this code in any form
    '           without the express written permission of the
    '           copyright holder.
    '
    ' Description:   This function calculates the number of years,
    '           months, days, hours, minutes and seconds between
    '           two dates, as elapsed time.
    '
    ' Inputs:    Interval:   Intervals to be displayed (a string)
    '           Date1:      The lower date (see below)
    '           Date2:      The higher date (see below)
    '           ShowZero:   Boolean to select showing zero elements
    '
    ' Outputs:   On error: Null
    '           On no error: Variant containing the number of years,
    '               months, days, hours, minutes & seconds between
    '               the two dates, depending on the display interval
    '               selected.
    '           If Date1 is greater than Date2, the result will
    '               be a negative value.
    '           The function compensates for the lack of any intervals
    '               not listed. For example, if Interval lists "m", but
    '               not "y", the function adds the value of the year
    '               component to the month component.
    '           If ShowZero is True, and an output element is zero, it
    '               is displayed. However, if ShowZero is False or
    '               omitted, no zero-value elements are displayed.
    '               For example, with ShowZero = False, Interval="ym",
    '               elements = 0 & 1 respectively, the output string
    '               will be "1 month" - not "0 years 1 month".

    ' Additional changes:
    ' 1) Formats associated with date segments
    ' 2) Changed order of arguments

    On Error GoTo Err

    Dim varTemp As Variant, baseDate As Date
    Dim diffY As Long, diffM As Long, diffD As Long
    Dim diffH As Long, diffN As Long, diffS As Long
    Dim y As Boolean, m As Boolean, d As Boolean
    Dim h As Boolean, n As Boolean, s As Boolean
    Dim ctr As Integer, tmpDate As Date, swapped As Boolean

    '***********************************************
    'Change the following constants according to the
    'desired output language
    Const Yvar = " year": Const Yvars = " years"
    Const Mvar = " month": Const Mvars = " months"
    Const Dvar = " day": Const Dvars = " days"
    Const Hvar = " hour": Const Hvars = " hours"
    Const Nvar = " minute": Const Nvars = " minutes"
    Const Svar = " second": Const Svars = " seconds"

    Const INTERVALS As String = "dmyhns"
    'Check that Interval contains valid characters
    For ctr = 1 To Len(Interval)
        If InStr(1, INTERVALS, Mid(Interval, ctr, 1)) = 0 Then
            Exit Function
        End If
    Next ctr

    'Check that valid dates have been entered
    If Not (IsDate(Date1)) Then Exit Function
    If Not (IsDate(Date2)) Then Exit Function

    'If necessary, swap the dates, to ensure that
    'Date1 is lower than Date2
    If Date1 > Date2 Then
        tmpDate = Date1
        Date1 = Date2
        Date2 = tmpDate
        swapped = True
    End If

    Diff2Dates = Null
    varTemp = Null

    'What intervals are supplied
    y = (InStr(1, Interval, "y") > 0)
    m = (InStr(1, Interval, "m") > 0)
    d = (InStr(1, Interval, "d") > 0)
    h = (InStr(1, Interval, "h") > 0)
    n = (InStr(1, Interval, "n") > 0)
    s = (InStr(1, Interval, "s") > 0)

    'Debug.Print "Date1: " & Date1
    'Debug.Print "Date2: " & Date2

    'Get the cumulative differences
    If y Then
        diffY = Abs(DateDiff("yyyy", Date1, Date2)) - _
                IIf(Format(Date1, "mmddhhnnss") <= Format(Date2, "mmddhhnnss"), 0, 1) '**
        Date1 = DateAdd("yyyy", diffY, Date1)
    End If
    If m Then
        diffM = Abs(DateDiff("m", Date1, Date2)) - _
                IIf(Format(Date1, "ddhhnnss") <= Format(Date2, "ddhhnnss"), 0, 1) '**
        Date1 = DateAdd("m", diffM, Date1)
    End If
    If d Then
        diffD = Abs(DateDiff("d", Date1, Date2)) - _
                IIf(Format(Date1, "hhnnss") <= Format(Date2, "hhnnss"), 0, 1) '**
        Date1 = DateAdd("d", diffD, Date1)
    End If
    If h Then
        diffH = Abs(DateDiff("h", Date1, Date2)) - _
                IIf(Format(Date1, "nnss") <= Format(Date2, "nnss"), 0, 1) '**
        Date1 = DateAdd("h", diffH, Date1)
    End If
    If n Then
        diffN = Abs(DateDiff("n", Date1, Date2)) - _
                IIf(Format(Date1, "ss") <= Format(Date2, "ss"), 0, 1) '**
        Date1 = DateAdd("n", diffN, Date1)
    End If
    If s Then
        diffS = Abs(DateDiff("s", Date1, Date2))
        Date1 = DateAdd("s", diffS, Date1)
    End If

    'Set the output display
    If y And (diffY > 0 Or ShowZero) Then
        varTemp = IIf(swapped, IIf(diffY > 0, -diffY, diffY), diffY) & _
                    IIf(diffY <> 1, Yvars, Yvar)
    End If
    If m And (diffM > 0 Or ShowZero) Then
        If m Then
            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                        diffM & IIf(diffM <> 1, Mvars, Mvar)
        End If
    End If
    If d And (diffD > 0 Or ShowZero) Then
        If d Then
            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                        diffD & IIf(diffD <> 1, Dvars, Dvar)
        End If
    End If
    If h And (diffH > 0 Or ShowZero) Then
        If h Then
            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                        diffH & IIf(diffH <> 1, Hvars, Hvar)
        End If
    End If
    If n And (diffN > 0 Or ShowZero) Then
        If n Then
            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                        diffN & IIf(diffN <> 1, Nvars, Nvar)
        End If
    End If
    If s And (diffS > 0 Or ShowZero) Then
        If s Then
            varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                        diffS & IIf(diffS <> 1, Svars, Svar)
        End If
    End If

    Diff2Dates = Trim(varTemp)
    Exit Function 
Err:
    Diff2Dates = Null
End Function

  21. Close the Visual Basic Editor.

  22. Open the form in Form view. Select the desired interval check boxes, type dates into the two date text boxes, and then click the button. The difference between the two dates is displayed in the Results text box.

    Aa139962.odc_actips08(en-us,office.10).gif

    Figure 8. Form showing the results of the Date2Diff function.

Convert a Number from One Base to Another

You can use the functions in this section to convert numbers from one base to another, including decimal, binary, hex, octal and Roman.

Note These procedures were contributed by, and are used with the permission of, Graham R. Seach, Microsoft Access MVP.

To use these functions, you could use a calling subroutine in a form, page, or module in your database application. For example, to convert the decimal number 1989 into a Roman number, you could use the following statement:

Num2Num(1989, nnDecimal, nnRoman)

The result would be MCMLXXXIX.

To convert the binary number 111101 into an octal number, you could use the following statement:

Num2Num(111101, nnBinary, nnOctal)

The result would be 75.

The conversion functions are listed below:

' Author: &#169;Copyright 2001 Pacific Database Pty Limited
' Graham R Seach gseach@pacificdb.com.au
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
'
' You may freely use and distribute this code
' with any applications you may develop, on the
' condition that the copyright notice remains
' unchanged, and intact as part of the code. You
' may not sell or publish this code in any form
' without the express written permission of the
' copyright holder.
'
' Description: This function converts numbers from
' one base to another, including decimal, binary
' hex, octal and Roman
'
' Inputs: varNum: The number to be converted.
' From_Type: is the enum value representing the
' base the supplied number is to be converted from.
' To_Type: is the enum value representing the
' base the supplied number is to be converted to.
'
' Outputs: None.
'
Public Enum nnType
    nnBinary = 2
    nnOctal = 8
    nnDecimal = 10
    nnHex = 16
    nnRoman = 99
End Enum

Public Function Num2Num(varNum As Variant, From_Type As nnType, To_Type As nnType) As Variant
    'This module converts 16-bit numbers between decimal, binary, hex & octal.
    'The "Check..." functions verify that the numbers supplied are what they say they are.
    'The "...2..." functions do the conversions.
    
    Dim strType As String
    If From_Type = To_Type Then Num2Num = "": Exit Function
    
    strType = CStr(From_Type) & CStr(To_Type)
    Select Case strType
        Case "299" 'Bin2Roman
            CheckBin (varNum)
            Num2Num = Num2Roman(Bin2Dec(CStr(varNum)))
        Case "899 'Oct2Roman"
            CheckOct (varNum)
            Num2Num = Num2Roman(Oct2Dec(CStr(varNum)))
        Case "1099" 'Dec2Roman
            CheckDec (varNum)
            Num2Num = Num2Roman(varNum)
        Case "1699" 'Hex2Roman
            CheckHex (varNum)
            Num2Num = Num2Roman(Hex2Dec(CStr(varNum)))
        Case "992" 'Roman2Bin
            CheckRoman (varNum)
            Num2Num = Dec2Bin(Roman2Dec(varNum))
        Case "998" 'Roman2Oct
            CheckRoman (varNum)
            Num2Num = Dec2Oct(Roman2Dec(varNum))
        Case "9910" 'Roman2Dec
            CheckRoman (varNum)
            Num2Num = Roman2Dec(varNum)
        Case "9916" 'Roman2Hex
            CheckRoman (varNum)
            Num2Num = Dec2Hex(Roman2Dec(varNum))
        Case "28" 'Bin2Oct
            CheckBin (varNum)
            Num2Num = Bin2Oct(CStr(varNum))
        Case "210" 'Bin2Dec
            CheckBin (varNum)
            Num2Num = Bin2Dec(CStr(varNum))
        Case "216" 'Bin2Hex
            CheckBin (varNum)
            Num2Num = Bin2Hex(CStr(varNum))
        Case "82" 'Oct2Bin
            CheckOct (varNum)
            Num2Num = Oct2Bin(CStr(varNum))
        Case "810" 'Oct2Dec
            CheckOct (varNum)
            Num2Num = Oct2Dec(CStr(varNum))
        Case "816" 'Oct2Hex
            CheckOct (varNum)
            Num2Num = Oct2Hex(CStr(varNum))
        Case "102" 'Dec2Bin
            CheckDec (varNum)
            Num2Num = Dec2Bin(CLng(varNum))
        Case "108" 'Dec2Oct
            CheckDec (varNum)
            Num2Num = Dec2Oct(CLng(varNum))
        Case "1016" 'Dec2Hex
            CheckDec (varNum)
            Num2Num = Dec2Hex(CLng(varNum))
        Case "162" 'Hex2Bin
            CheckHex (varNum)
            Num2Num = Hex2Bin(CStr(varNum))
        Case "168" 'Hex2Oct
            CheckHex (varNum)
            Num2Num = Hex2Oct(CStr(varNum))
        Case "1610" 'Hex2Dec
            CheckHex (varNum)
            Num2Num = Hex2Dec(CStr(varNum))
        Case Else
            Num2Num = ""
    End Select
End Function

Private Function Dec2Bin(lngDec As Long) As String
    Dim lngCtr As Integer
    
    Do
        If (lngDec And 2 ^ lngCtr) = 2 ^ lngCtr Then
            Dec2Bin = "1" & Dec2Bin
        Else
            Dec2Bin = "0" & Dec2Bin
        End If
        lngCtr = lngCtr + 1
    Loop Until CLng(2 ^ lngCtr) > lngDec
End Function

Private Function Dec2Hex(lngDec As Long) As String
    Dec2Hex = Hex(lngDec)
End Function

Private Function Dec2Oct(lngDec As Long) As String
    Dec2Oct = Oct(lngDec)
End Function

Private Function Hex2Dec(ByVal strHex As String) As Long
    ' Check to see if string already begins with &H.
    If Left(strHex, 2) <> "&H" Then strHex = "&H" & strHex

    ' Check to see if string contains Decimals and strip them out.
    If InStr(1, strHex, ".") Then strHex = Left(strHex, (InStr(1, strHex, ".") - 1))

    Hex2Dec = CLng(strHex)
End Function

Private Function Hex2Bin(ByVal strHex As String) As String
    Dim intCtr As Integer
    For intCtr = 1 To Len(strHex)
        Hex2Bin = Hex2Bin & CStr(Dec2Bin(Hex2Dec(Mid(strHex, intCtr, 1))))
    Next intCtr
End Function

Private Function Hex2Oct(ByVal strHex As String) As String
    Hex2Oct = Dec2Oct(CLng(Hex2Dec(strHex)))
End Function

Private Function Bin2Dec(ByVal strBin As String) As Long
    Dim intCtr As Integer, intPower As Integer
    Bin2Dec = 0
    intPower = 0
    For intCtr = Len(strBin) To 1 Step -1
        Bin2Dec = Bin2Dec + CLng(Mid(strBin, intCtr, 1) * (2 ^ intPower))
        intPower = intPower + 1
    Next intCtr
End Function

Private Function Bin2Hex(ByVal strBin As String) As String
    Bin2Hex = Dec2Hex(Bin2Dec(strBin))
End Function

Private Function Bin2Oct(ByVal strBin As String) As String
    Bin2Oct = Dec2Oct(Bin2Dec(strBin))
End Function

Private Function Oct2Dec(ByVal strOct As String) As Long
    ' Check to see if string already begins with &O
    If Left(strOct, 2) <> "&O" Then strOct = "&O" & strOct
    
    ' Check to see if string contains Decimals and strip them out
    If InStr(1, strOct, ".") Then strOct = Left(strOct, (InStr(1, strOct, ".") - 1))

    Oct2Dec = CLng(strOct)
End Function

Private Function Oct2Bin(ByVal strOct As String) As String
    Oct2Bin = Dec2Bin(Oct2Dec(strOct))
End Function

Private Function Oct2Hex(ByVal strOct As String) As String
    Oct2Hex = Dec2Hex(Oct2Dec(strOct))
End Function

Public Function Num2Roman(ByVal lngNum As Variant) As String
    Const Digits = "IVXLCDM"
    Dim ctr As Integer, intDigit As Integer, strTmp As String
    
    ctr = 1
    strTmp = ""
    Do While lngNum > 0
        intDigit = lngNum Mod 10
        lngNum = lngNum \ 10
        
        Select Case intDigit
            Case 1: strTmp = Mid(Digits, ctr, 1) & strTmp
            Case 2: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 3: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 4: strTmp = Mid(Digits, ctr, 2) & strTmp
            Case 5: strTmp = Mid(Digits, ctr + 1, 1) & strTmp
            Case 6: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 7: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 8: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 9: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr + 2, 1) & strTmp
        End Select
        ctr = ctr + 2
    Loop
    
    Num2Roman = strTmp
End Function

Private Function Roman2Dec(strNum As Variant) As Double
    Const Digits = "IVXLCDM"
    
    Dim ctr As Integer, num As Double, intLen As Integer
    Dim strTmp As String, prevStr As String
    
    intLen = Len(strNum)
    
    For ctr = 1 To intLen
        strTmp = UCase(Mid(strNum, ctr, 1))
        
        Select Case strTmp
            Case "I" '1
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 1
                    Else
                        num = num + 1
                    End If
                Else
                    num = num + 1
                End If
            Case "V" '5
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 5
                    Else
                        num = num + 5
                    End If
                Else
                    num = num + 5
                End If
            Case "X" '10
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 10
                    Else
                        num = num + 10
                    End If
                Else
                    num = num + 10
                End If
            Case "L" '50
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 50
                    Else
                        num = num + 50
                    End If
                Else
                    num = num + 50
                End If
            Case "C" '100
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 100
                    Else
                        num = num + 100
                    End If
                Else
                    num = num + 100
                End If
            Case "D" '500
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 500
                    Else
                        num = num + 500
                    End If
                Else
                    num = num + 500
                End If
            Case "M" '1000
                If ctr < intLen Then
                    If InStr(1, Digits, Mid(strNum, ctr + 1, 1)) > InStr(1, Digits, strTmp) Then
                        num = num - 1000
                    Else
                        num = num + 1000
                    End If
                Else
                    num = num + 1000
                End If
        End Select
    Next ctr
    
    Roman2Dec = num
End Function

Private Sub CheckDec(varDec As Variant)
    'Check for numeric value
    If Not (IsNumeric(varDec)) Then Err.Raise 13
    
    'Check for maximum allowable value < 4294967295
    If varDec > 65535 Or varDec < 0 Then Err.Raise 6
End Sub

Private Sub CheckOct(varOct As Variant)
    Dim intCtr As Integer
    'Check for numeric value
    If Not (IsNumeric(varOct)) Then Err.Raise 13
    
    'Check for valid octal range
    For intCtr = 1 To Len(varOct)
        If Mid(varOct, intCtr, 1) > 7 Then Err.Raise 6
    Next intCtr
    
    'Check for maximum allowable value < 177777
    If varOct > 177777 Then Err.Raise 6
End Sub

Private Sub CheckBin(varBin As Variant)
    Dim intCtr As Integer
    'Check for numeric value
    If Not (IsNumeric(varBin)) Then Err.Raise 13

    'Check for valid binary range
    For intCtr = 1 To Len(varBin)
        If Mid(varBin, intCtr, 1) > 1 Then Err.Raise 6
    Next intCtr
    
    'Check for maximum allowable value < 1111111111111111
    If Len(varBin) > 16 Then Err.Raise 6
End Sub

Private Sub CheckHex(varHex As Variant)
    Dim intCtr As Integer, intAsc As Integer
    'Check for valid hex range
    
    For intCtr = 1 To Len(varHex)
        intAsc = Asc(Mid(varHex, intCtr, 1))
        If (intAsc < 48 Or intAsc > 57) And (intAsc < 65 Or intAsc > 70) Then Err.Raise 13
    Next intCtr
    
    'Check for maximum allowable value
    If Len(varHex) > 4 Then Err.Raise 6
End Sub

Private Sub CheckRoman(varRoman As Variant)
    Dim intCtr As Integer, char As String
    
    For intCtr = 1 To Len(varRoman)
        char = UCase(Mid(varRoman, intCtr, 1))
        Select Case char
            Case "I", "V", "X", "L", "C", "D", "M"
            Case Else: Err.Raise 6
        End Select
    Next intCtr
End Sub

Convert Numbers to Text

You can use the functions in this section to convert numbers to their textual representation, including real, verbatim, currency, kilometers, miles and Roman.

Note These procedures were contributed by, and are used with the permission of, Graham R. Seach Microsoft Access MVP.

To use these functions, you could use a calling subroutine in a form, page, or module in your database application. For example, to convert the number 1989 into a Roman number, you could use the following statement:

Num2Text(1989,ConvTypeRoman,CapUpperCase)

The result would be MCMLXXXIX.

To convert the number 11989.35 into a currency amount, you could use the following statement:

Num2Text(11989.35,ConvTypeCurrency,CapProperCase)

The result would be Eleven Thousand Nine Hundred And Eighty Nine Dollars And Thirty Five Cents.

The conversion functions are listed below:

' Author: &#169;Copyright 2001 Pacific Database Pty Limited
' Graham R Seach gseach@pacificdb.com.au
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
'
' You may freely use and distribute this code
' with any applications you may develop, on the
' condition that the copyright notice remains
' unchanged, and intact as part of the code. You
' may not sell or publish this code in any form
' without the express written permission of the
' copyright holder.
'
' Description: This function converts numbers to
' their textual representation, including real, verbatim
' currency, miles and Roman.
'
' Inputs: dblNum: The number to be converted.
' intType: is the enum value representing the
' number type to be converted to.
' intCapType: is the enum value representing the
' output capitalization required.
'
' Outputs: None.
'
Public Enum ConvType
    ConvTypeReal = 1
    ConvTypeVerbatim = 2
    ConvTypeCurrency = 3
    ConvTypeKm = 4
    ConvTypeMi = 5
    ConvTypeRoman = 6
End Enum

Public Enum CapType
    CapUpperCase = 1
    CapLowerCase = 2
    CapProperCase = 3
    CapProperCase_LC_and = 4
End Enum

Public Function Num2Text(dblNum As Double, intType As ConvType, Optional intCapType As CapType = 1) As String
    Dim strNum As String
    Dim strFrac As String
    Dim strTemp As String
    Dim strReturn As String
    Dim iCtr As Integer
    Dim iPart As Integer
    
    iPart = 1
    strFrac = ""
    strNum = CStr(dblNum)
    
    'Check for fractional part
    iCtr = InStr(1, strNum, ".")
    If iCtr <> 0 Then
        If intType = 6 Then
            'If converting to Roman Numerals, can't have fractions
            Num2Text = CStr(dblNum)
            Exit Function
        End If
        
        If (intType = ConvTypeCurrency) Then
            If (Len(strNum) - iCtr) = 1 Then strNum = strNum & "0"
            strFrac = ConvertReal(CDbl(Right(strNum, Len(strNum) - iCtr)))
        Else
            strFrac = ConvertVerbatim(CDbl(Right(strNum, Len(strNum) - iCtr)))
        End If
        strNum = Left(strNum, iCtr - 1)
    End If
    
    Select Case intType
        Case 1, 3, 4, 5 '*** Convert into real numbers (1) or currency (3) ***
            'Pad strNum to blocks of 3
            Do While (Len(strNum) / 3) - Int(Len(strNum) / 3) <> 0
                strNum = "0" & strNum
            Loop
            
            For iCtr = Len(strNum) - 2 To 1 Step -3
                strTemp = ConvertReal(Mid(strNum, iCtr, 3))
                strTemp = strTemp & AddNouns(strTemp, iPart, (intType = ConvTypeCurrency) And (iPart = 1))
                strReturn = strTemp & strReturn
                iPart = iPart + 1
            Next iCtr
        Case 2 '*** Convert the individual numbers verbatim ***
            strReturn = ConvertVerbatim(CDbl(strNum))
        Case 6 '*** Convert to Roman Numerals ***
            Num2Text = Num2Roman(CLng(dblNum))
            GoTo SetCase
    End Select
    
    If (strFrac <> "") Then
        Select Case intType
            Case ConvTypeCurrency: strFrac = strFrac & " cents"
            Case ConvTypeKm: strFrac = " point " & strFrac & " kilometers"
            Case ConvTypeMi: strFrac = " point " & strFrac & " miles"
            Case Else: strFrac = " point " & strFrac
        End Select
    End If
    
    Num2Text = strReturn & strFrac
    If Left(Num2Text, 4) = " and" Then Num2Text = Right(Num2Text, Len(Num2Text) - 5)
    
SetCase:
    Select Case intCapType
        Case 1 'Uppercase
            Num2Text = UCase(Num2Text)
        Case 2 'Lowercase
            Num2Text = LCase(Num2Text)
        Case 3 'Propercase
            Num2Text = StrConv(Num2Text, vbProperCase)
        Case 4 'Propercase with Lowercase 'and'
            Num2Text = Replace(StrConv(Num2Text, vbProperCase), "And", "and")
    End Select
End Function

Private Function ConvertVerbatim(dblNum As Double) As String
    Dim iCtr As Integer
    Dim iMaxlen As Integer
    Dim strNum As String
    
    strNum = CStr(dblNum)
    ConvertVerbatim = ""
    iMaxlen = Len(strNum)
    
    For iCtr = 1 To iMaxlen
        Select Case Asc(Mid(strNum, iCtr, 1)) - 48
            Case 0: ConvertVerbatim = ConvertVerbatim & "zero"
            Case 1: ConvertVerbatim = ConvertVerbatim & "one"
            Case 2: ConvertVerbatim = ConvertVerbatim & "two"
            Case 3: ConvertVerbatim = ConvertVerbatim & "three"
            Case 4: ConvertVerbatim = ConvertVerbatim & "four"
            Case 5: ConvertVerbatim = ConvertVerbatim & "five"
            Case 6: ConvertVerbatim = ConvertVerbatim & "six"
            Case 7: ConvertVerbatim = ConvertVerbatim & "seven"
            Case 8: ConvertVerbatim = ConvertVerbatim & "eight"
            Case 9: ConvertVerbatim = ConvertVerbatim & "nine"
        End Select
        
        If iCtr < iMaxlen Then ConvertVerbatim = ConvertVerbatim & " "
    Next iCtr
End Function

Private Function ConvertReal(dblNum As Double) As String
    Dim strNum As String
    Dim iCtr As Integer
    Dim strTemp As String
    Dim sN As String
    
    strNum = CStr(dblNum)
    
    'Pad strNum to blocks of 3
    Do While (Len(strNum) / 3) - Int(Len(strNum) / 3) <> 0
        strNum = "0" & strNum
    Loop
    
    If Mid(strNum, 1, 1) <> 0 Then strTemp = ConvertVerbatim(Left(strNum, 1)) & " hundred"
    If Mid(strNum, 2, 1) <> 0 Or Mid(strNum, 3, 1) <> 0 Then strTemp = strTemp & " and"
    sN = Mid(strNum, 2, 2)
    
    Select Case Asc(Mid(strNum, 2, 1)) - 48
        Case 0:
        Case 1
            strTemp = strTemp & Switch(sN = "10", " ten", sN = "11", " eleven", sN = "12", " twelve", _
                    sN = "13", " thirteen", sN = "14", " fourteen", sN = "15", " fifteen", _
                    sN = "16", " sixteen", sN = "17", " seventeen", sN = "18", " eighteen", _
                    sN = "19", " nineteen")
        Case 2: strTemp = strTemp & " twenty"
        Case 3: strTemp = strTemp & " thirty"
        Case 4: strTemp = strTemp & " forty"
        Case 5: strTemp = strTemp & " fifty"
        Case 6: strTemp = strTemp & " sixty"
        Case 7: strTemp = strTemp & " seventy"
        Case 8: strTemp = strTemp & " eighty"
        Case 9: strTemp = strTemp & " ninety"
    End Select
    
    If Mid(strNum, 2, 1) <> 1 Then strTemp = strTemp & " " & ConvertVerbatim(Mid(strNum, 3, 1))
    If Right(strTemp, 4) = "zero" Then strTemp = Left(strTemp, Len(strTemp) - 5)
    ConvertReal = strTemp
End Function

Private Function Num2Roman(ByVal lngNum As Long) As String
    Const Digits = "IVXLCDM"
    Dim ctr As Integer, intDigit As Integer, strTmp As String
    
    ctr = 1
    strTmp = ""
    Do While lngNum > 0
        intDigit = lngNum Mod 10
        lngNum = lngNum \ 10
        
        Select Case intDigit
            Case 1: strTmp = Mid(Digits, ctr, 1) & strTmp
            Case 2: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 3: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 4: strTmp = Mid(Digits, ctr, 2) & strTmp
            Case 5: strTmp = Mid(Digits, ctr + 1, 1) & strTmp
            Case 6: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 7: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 8: strTmp = Mid(Digits, ctr + 1, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & Mid(Digits, ctr, 1) & strTmp
            Case 9: strTmp = Mid(Digits, ctr, 1) & Mid(Digits, ctr + 2, 1) & strTmp
        End Select
        ctr = ctr + 2
    Loop
    
    Num2Roman = strTmp
End Function

Private Function AddNouns(strNum As String, ByVal intPart As Integer, booCurrency As Boolean) As String
    Select Case intPart
        Case 1: If (booCurrency = True) Then AddNouns = " dollars"
        Case 2: AddNouns = " thousand "
        Case 3: AddNouns = " million "
        Case 4: AddNouns = " billion "
        Case 5: AddNouns = " trillion "
        Case 6: AddNouns = " quadrillion "
        Case 7: AddNouns = " quintillion "
        Case 8: AddNouns = " sextillion "
        Case 9: AddNouns = " septillion "
        Case 10: AddNouns = " octillion"
    End Select
End Function