Project Perfect
PROJECT  PERFECT
                 Project Management Software
                          Specialists in Project Infrastructure

Microsoft Access Development Tips

Home - Microsoft Access Development - Microsoft Access Tips

Sample Microsoft Access VBA

Using an Expanded Text Box

The following are some samples of VBA code that may prove useful.

Open an Expanded Text form by right clicking on a text box. This is useful if you have a text box that may only display one or two lines of text and you can potentially have ten or twenty lines. Viewing in the expanded text box allows you to read the text and also enter or edit. The information in the expanded form is moved to the text box through a "Close and Update" button. There is also a "Cancel" button on the Expanded Text Form.

The following code goes in the main form, and is used to open the expanded text form.

Public Sub subOpenExpandedText()
'Function to open the text input form on long text fields
On Error Resume Next
DoCmd.OpenForm "frmExpandedText"

' PASTE TO text box Mousedown Event ----------------------
' Display bulk text input screen
' On Error Resume Next
' If (Button = acRightButton) Then
' DoCmd.RunCommand acCmdSaveRecord
' subOpenExpandedText
' End If
'-----------
-------------------------------------------

End Sub

The form to display expended text has a single text box called txtExpanded. It is around 17 cm wide and 8.5 cm high. There are two buttons. One is to "Close and Update" and the other to "Cancel". Paste the following code into the form.

Option Compare Database
Dim strText As String
Dim intFieldLength As Integer
Dim strFormName As String
Dim Screen_ActiveSubformControl As Control

'+++++++++++++++ Start of Opening Actions ++++++++++++++++++++
'
Private Sub Form_Open(Cancel As Integer)
'What : Function to get ready once opened.

' There is a problem if the subform name being passed belongs to a subform within a subform
' In order to overcome this, we name the control explicitely in the subform and skip the naming
' of the subform in this code. To identify the situation we pass the argument below which tells
' the program to skip setting a control name.

If Me.OpenArgs = "2Subforms" Then GoTo SkipsCtl

If (Me.OpenArgs & "" = "") Then
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Screen.ActiveControl.Name)
Else
If (Me.OpenArgs = Screen.ActiveForm.Name) Then
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Screen.ActiveControl.Name)
Else
Set ctlCurrentControl = Forms(Screen.ActiveForm.Name)(Me.OpenArgs).Form(Screen.ActiveControl.Name)
End If
End If

SkipsCtl:

Me.txtExpanded = ctlCurrentControl

End Sub
'
'=============== End of Opening Actions ====================

'+++++++++++++++ Start of Closing Actions +++++++++++++++++++++
'
' NO CLOSING ACTIONS
'
'=============== End of Closing Actions ======================

'++++++++++++ Start of Miscellaneous Buttons Click +++++++++++++++
'

Private Sub btnClose_Click()
On Error GoTo Err_btnClose_Click


If Not IsNull(Me.txtExpanded) Then
    strText = Me.txtExpanded
    ctlCurrentControl = strText
End If

DoCmd.Close

Exit_btnClose_Click:
Exit Sub

 

Err_btnClose_Click:
MsgBox Err.Description
Resume Exit_btnClose_Click

End Sub

Private Sub btnCancel_Click()
On Error GoTo Err_btnCancel_Click

DoCmd.Close

Exit_btnCancel_Click:
Exit Sub

Err_btnCancel_Click:
MsgBox Err.Description
Resume Exit_btnCancel_Click

End Sub
'
'=========== End of Miscellaneous buttons =====================

' ++++++++++++++ Start of Subs and Functions +++++++++++++++++++
'

Function DisplayActiveSubformName()
    Dim Msg As String
    Dim CR As String
    CR = Chr$(13) ' Carriage Return.

If Set_Screen_ActiveSubformControl() = False Then
    Msg = "There is no active subform!"
  Else
    Msg = "Active Form Name = " & Screen.ActiveForm.Name
    Msg = Msg & CR
    Msg = Msg & "Active ControlName = " & Screen.ActiveControl.Name
    Msg = Msg & CR
    Msg = Msg & "Active Subform ControlName = "
    Msg = Msg & Screen_ActiveSubformControl.Name
    Msg = Msg & CR
    Msg = Msg & "Active Subform Form Name = "
    Msg = Msg & Screen_ActiveSubformControl.Form.Name
End If

MsgBox Msg

End Function

Function Set_Screen_ActiveSubformControl()
    Dim frmActive As Form, ctlActive As Control
    Dim hWndParent As Long

' Clear the control variable.
    Set Screen_ActiveSubformControl = Nothing

' Assume a subform is not active.
    Set_Screen_ActiveSubformControl = False

' Get the active form and control.
    On Error Resume Next
    Set frmActive = Screen.ActiveForm
    Set ctlActive = Screen.ActiveControl
    If Err <> 0 Then Exit Function

' Get the unique window handle identifying the form
' .. the active control is on.

    hWndParent = ctlActive.Parent.Properties("hWnd")

' If the active form window handle is the same as the window
' handle of the form the active control is on, then we are on the
' mainform, so exit.

    If hWndParent = frmActive.hWnd Then Exit Function

' Find a subform control that has a window handle matching the
' .. window handle of the form the active control is on.

    Set_Screen_ActiveSubformControl = FindSubform(frmActive, _
    hWndParent)

End Function

Function FindSubform(frmSearch As Form, hWndFind As Long)
    Dim I As Integer
    On Error GoTo Err_FindSubForm

' Assume we will find a subform control with a window
' .. handle matching hWndFind.

    FindSubform = True

' Visit each control on the form frmSearch.
     For I = 0 To frmSearch.Count - 1
     ' If the control is a subform control...
         If TypeOf frmSearch(I) Is SubForm Then
         ' .. does the window handle match the one we are looking for?
        If frmSearch(I).Form.hWnd = hWndFind Then
            ' We found it! Set the global control variable and exit.
            Set Screen_ActiveSubformControl = frmSearch(I)
            Exit Function
         Else
            ' Otherwise, search this subform control (recursively)
            ' .. to see if it contains a sub-subform control
            ' .. with a window handle matching the one we are
            ' .. interested in.           

            ' If we found a subform control, then exit.
            If FindSubform(frmSearch(I).Form, hWndFind) Then
            Exit Function
        End If
       End If
    End If
Next I

Bye_FindSubform:
    ' If we didn't exit the function earlier, then there is no
    ' .. subform or sub-subform control on this form that has a window
    ' .. handle matching the one we are interested in, so return false.  

    FindSubform = False
Exit Function

Err_FindSubForm:
    MsgBox Error$, 16, "FindSubform"
    Resume Bye_FindSubform

End Function
'
' ================ End of Subs and Functions ==================

 

Return to the top