How to validate excel textbox values using Access VBA

[JFKJr]

Hello everyone, the following Access VBA code opens an excel file and creates textboxes in a given range of cells dynamically. The code attaches "MouseUP" and "Exit" events to the textboxes (using the following "DateTextBox" class module).

Whenever a user enters in to the textbox, the code displays "Please enter date in mm/dd/yyyy format (for ex: 01/01/2009)." message which is accomplished using "MouseUp" event.

And, I used "Exit" event to validate the value that the user entered in to the textbox and display an error message if the user enter a date in past.

But somehow the "Exit" event is not working.

Please kindly let me know how to solve this issue?

Thanks.

1. Created an Access VBA module to open and create textboxes in an excel spreadsheet dynamically:

Public eXL As New eventsXL
 
Function Create_TextBox()
Dim OLEObj As OLEObject
Dim myRng As Range, myCell As Range
 
 
With eXL
If .XL Is Nothing Then Set .XL = New Excel.Application
.XL.Visible = True
.XL.Interactive = True
Set .WB = .XL.Workbooks.Open("C:\Book1.xls", , False)
Set .WS = .WB.Worksheets("Example")
.WS.Activate
 
.XL.CommandBars("Control Toolbox").Visible = False
.WS.OLEObjects.Delete
 
Set myRng = .WS.Range("A2:A4")
For Each myCell In myRng.Cells
With myCell
    .NumberFormat = ";;;" 'hide the value in the cell
    Set OLEObj = .Parent.OLEObjects.Add _
                (ClassType:="Forms.TextBox.1", Link:=False, _
                DisplayAsIcon:=False, _
                Top:=.Top, _
                Left:=.Left, _
                Width:=.Width, _
                Height:=.Height)
End With
 
.AddTextBoxEvents OLEObj.Object
Next myCell
End With
End Function

2. Created "eventsXL" class module to attach events to the created textboxes:

Public WithEvents XL As Excel.Application
Public WithEvents WB As Excel.Workbook
Public WithEvents WS As Excel.Worksheet
Private myTxb As New VBA.Collection
 
Public Property Get myTextBoxes() As VBA.Collection
    Set myTextBoxes = myTxb
End Property
 
Public Function AddTextBoxEvents(obj As Variant) As DateTextBox
    Set AddTextBoxEvents = New DateTextBox
    Set AddTextBoxEvents.myTextBox = obj
    Me.myTextBoxes.Add AddTextBoxEvents
End Function
 
Private Sub XL_WorkbookBeforeClose(ByVal WB1 As Excel.Workbook, Cancel As Boolean)
With XL.Workbooks
XL.Quit
Set eXL.XL = Nothing
Set eXL.WB = Nothing
Set eXL.WS = Nothing
Set eXL = Nothing
End With
Exit Sub
End Sub

3. Created "DateTextBox" class module to define events that needs to attached to the created date textboxes:

Public WithEvents txb As MSForms.TextBox
 
Public Property Get myTextBox() As MSForms.TextBox
Set myTextBox = txb
End Property
 
Public Property Set myTextBox(ByRef myText As MSForms.TextBox)
Dim curDate As String
Set txb = myText
curDate = Format(Date, "mm/dd/yyyy")
With txb
    .Text = curDate
End With
End Property
 
Public Sub txb_MouseUP(ByVal Button As Integer, _
         ByVal Shift As Integer, ByVal X As Single, _
         ByVal Y As Single)
MsgBox "Please enter date in mm/dd/yyyy format (for ex: 01/01/2009)."
End Sub
 
Public Sub txb_Exit(Cancel As Integer)
Dim curDate As String, mon As String, day As String, year As String
curDate = Format(Date, "mm/dd/yyyy")
dParts = Split(curDate, "/")
txbParts = Split(txb.Text, "/")
 
If (txbParts(0) <= dParts(0)) And (txbParts(1) < dParts(1)) And (txbParts(2) <= dParts(2)) Then
MsgBox "Please enter either the current date or the date in future!"
End If
End Sub

[NeoPa]

Try using the following for your class code :

Option Explicit
 
Public WithEvents txb As MSForms.TextBox
 
Public Property Get myTextBox() As MSForms.TextBox
  Set myTextBox = txb
End Property
 
Public Property Set myTextBox(ByRef myText As MSForms.TextBox)
  Set txb = myText
  txb.Text = Format(Date, "mm/dd/yyyy")
End Property
 
Public Sub txb_MouseUP(ByVal Button As Integer, _
                       ByVal Shift As Integer, _
                       ByVal X As Single, _
                       ByVal Y As Single)
  MsgBox "Please enter date in mm/dd/yyyy format (EG. 01/14/2009)."
End Sub
 
Public Sub txb_Exit(Cancel As Integer)
  If Date > CDate(txb.Text) Then
    MsgBox "Please enter a date that is not in the past!"
    Calcel = True
  End If
End Sub

NB. It doesn't validate that the data entered is a valid date.