Hi John,
Have implemented Uncle Gizmo's keypad and it works great when the form fields have a control source. My form is using unbound fields that are eventually used in an append query, so when I try to use the keypad I get "Invalid use of Null" which I think I've narrowed down to the unbound field not passing the control name.
I think its in this class module but I'm not knowledgable enough with code to manipulate it:
Option Compare Database
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>> Database by Tony Hine, alias Uncle Gizmo <<<
'>>> Created Oct, 2007 <<<
'>>> Last up-dated Dec 2007 <<<
'>>> Telephone International: +44 1635 522233 <<<
'>>> Telephone UK: 01635 533322 <<<
'>>> e-mail:
email@tonyhine.co.uk <<<
'>>> Skype: unclegizmo <<<
'>>> MSN messenger:
walter.tower@lycos.co.uk <<<
'>>> I post at the following forum (mostly) : <<<
'>>>
http://www.access-programmers.co.uk/forums/ (alias Uncle Gizmo) <<<
'>>> You can also find me on the Ecademy:
http://www.ecademy.com/user/tonyhine <<<
'>>> If my e-mail don't work, try this website:
http://www.tonyhine.co.uk/example_help.htm <<<
'>>> I have now started a forum which contains video instructions here: <<<
'>>>
http://msAccessHintsAndTips.Ning.Com/ <<<
'>>> NOT CHECKED AND TESTED FOR ERRORS!!!! Be Warned <<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'This Class Can be used anywhere and returns the name of the Screen Active Control, the Parent Form and other info
'It is also part of a pair of items:
'Both are needed for the calendar form to work
'clsGetActiveFrm (This Class)
'frmCalendar
'Copy the class "clsGetActiveFrm" and the form "frmCalendar" Into your project.
'You will also need to make sure your project has a reference to.....
'
'Reference:
'Microsoft visual basic for applications extensibility 5.3 (or the one relevant to your version of MS Access)
'Usage
'Dim GetActiveFrm As New clsGetActiveFrm
'
' Msgbox "Active Control : " & GetActiveFrm.prpScrActiveCtrl
' Msgbox "Date Control : " & GetActiveFrm.prpAssociateCtrl
' Set GetActiveFrm = Nothing
'Declare the private variables used in this Class
Private mAssociateFrm As Form
Private mHasPBkProc As Boolean
Private mstrScrActiveCtrl As String
Private mctlAssociateCtrl As Variant
Public Property Get prpAssociateFrm() As Form
Set prpAssociateFrm = mAssociateFrm
End Property 'prpAssociateFrm Get
Public Property Get prpHasPBkProc() As Boolean 'True if Function Named "fPassBackAct" is Found
prpHasPBkProc = mHasPBkProc
End Property 'prpHasPBkProc Get
Public Property Get prpScrActiveCtrl() As String
prpScrActiveCtrl = mstrScrActiveCtrl
End Property 'prpScrActiveCtrl Get
Public Property Get prpAssociateCtrl() As Variant
Set prpAssociateCtrl = mctlAssociateCtrl
End Property 'prpAssociateCtrl Get
Private Sub Class_Initialize()
On Error GoTo Err_ErrorHandler
If fAnyOpenFrms = False Then GoTo Exit_ErrorHandler 'Check if any Forms are Open, Exit if none are open...
Dim ctlCurrentControl As Control
Set ctlCurrentControl = Screen.ActiveControl 'Get the Control that is Active on the Form.
mstrScrActiveCtrl = ctlCurrentControl.Name 'now Get the Name of the Control
Dim ctlToTest As Control
Set ctlToTest = ctlCurrentControl
Dim X As Integer
For X = 1 To 20 'This will check to 20 levels
If Not fParentIsaForm(ctlToTest.Parent.Name) Then 'Is Parent a Form?
Set ctlToTest = ctlToTest.Parent 'No --- Then check the next Parent
Else
Set mAssociateFrm = ctlToTest.Parent 'Yes -- Then Set the Property to The Parent Form
Exit For
End If
Next X
mHasPBkProc = fProcExists(prpAssociateFrm, "fPassBackAct") 'True if Form has the Function "fPassBackAct" present
Dim strAssociateCtrl As String
If ctlCurrentControl.ControlType = acCommandButton Then 'Look for control named simarlarly to the Command button
strAssociateCtrl = fTextBoxName(prpScrActiveCtrl, "txt")
Else
strAssociateCtrl = ctlCurrentControl.Name 'Otherwise you've clicked on yourself (Not a Command Button)
End If
If fChkName(prpAssociateFrm, strAssociateCtrl) Then
Set mctlAssociateCtrl = prpAssociateFrm(strAssociateCtrl) 'Returns the Textbox as a Control to the Property
End If
Exit_ErrorHandler:
Set ctlCurrentControl = Nothing
Exit Sub
Err_ErrorHandler:
Select Case Err
Case 1 'Example of Trapping Error 1 --- Not sure there is an Error 1 I haven't seen it
MsgBox "produced by error code (1) please check your code ! Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description
Case Else
MsgBox "Error From --- clsGetActiveFrm Class_Initialize --- Error Number >>> " _
& Err.Number & " <<< Error Description >> " & Err.Description
End Select
Resume Exit_ErrorHandler
End Sub 'Class_Initialize
Private Function fParentIsaForm(strIsaForm As String) As Boolean
'From Access Help
fParentIsaForm = False
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllForms collection.
For Each obj In dbs.AllForms
If obj.Name = strIsaForm Then fParentIsaForm = True
Next obj
End Function 'fParentIsaForm
Private Function fTextBoxName(strCboName As String, strPreFix As String) As String
'Builds the anticipated name of the Textbox from the Combobox name by striping out the name of the Command Button
'from a Text string like "btnDOB" and then Prefixes it with "txt"
Dim strNamePart As String
strNamePart = Right(strCboName, Len(strCboName) - 3)
fTextBoxName = strPreFix & strNamePart
End Function 'fTextBoxName
Private Function fAnyOpenFrms() As Boolean
'Code from Access Help >>> If any Forms are open Return True, if no Forms open Return False
Dim blnOpen As Boolean
Dim intCounter As Integer
blnOpen = False
fAnyOpenFrms = False
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentProject
' Search for open AccessObject objects in AllForms collection.
For Each obj In dbs.AllForms
If obj.IsLoaded = True Then
intCounter = intCounter + 1
End If
Next obj
If intCounter > 1 Then fAnyOpenFrms = True
End Function 'fAnyOpenFrms
Function fProcExists(frmPassed As Form, strProc As String) As Boolean
'Usage >>> This message box will return true if Form "Form2" (Must Be Open) contains a procedure "fTest"
'MsgBox fProcExists("Form2", "fTest")
On Error GoTo Err_ErrorHandler
Dim intCounter As Integer
fProcExists = True
If frmPassed.HasModule = False Then
fProcExists = False
Exit Function
End If
'/////// May need to Check to see if the Form is Open
intCounter = frmPassed.Module.ProcCountLines(strProc, vbext_pk_Proc)
'This counter returns the position (Line number) of the procedure in the module, however if the procedure
'does not exist in the module, then error 35 is thrown and "fProcExists" set to False
'I realize this is not considered good practice, using an error thrown to check for something,
'however I still am looking for a way of doing it by looping through the names of the procedures
'in the form module. Haven't found a way to do that yet!
Exit_ErrorHandler:
Exit Function
Err_ErrorHandler:
Select Case Err
Case 35 'If Sub or Function not Defined then Return False
fProcExists = False
Case 2450 'Form not open
MsgBox "Form >>> " & frmPassed.Name & " <<< Is probably not open or does not Exist"
fProcExists = False
Case Else
MsgBox "Error From --- fProcExists --- Error Number >>> " _
& Err.Number & " <<< Error Description >> " & Err.Description
fProcExists = False
End Select
Resume Exit_ErrorHandler
End Function 'fProcExists
Private Function fChkName(frmPassForm As Form, strChkName As String) As Boolean
'Check to see if there is a Textbox with the same name as the Command Button ("txt" as the first three characters)
'If there is a Textbox with the same name as the Command Button Return True, otherwise Return False
fChkName = False
Dim Ctl As Control
Dim intCounter As Integer
For Each Ctl In frmPassForm.Controls
If Ctl.ControlType = acTextBox Or Ctl.ControlType = acComboBox Then 'Find text boxes only
If Ctl.Name = strChkName Then
intCounter = intCounter + 1
End If
End If
Next Ctl
If intCounter = 1 Then fChkName = True
End Function 'fChkName
Thanks to anything who has a squiz at this and can help me on the right track.
Kind regards,
Rachael
