CODEWITHSUNDEEP
classvbams-access
Smandoli
Smandoli

Reputation: 7019

Referencing reusable forms (2 deep) in MS Access

I have multiple Members, and each one has a record which contains several memo fields:

Member ID    Entry A       Entry B
   1        [memo text]   [memo text]
   2        [memo text]   [memo text]
   3        [memo text]   [memo text]

In Access 2007, I am creating a Memo Entry form that is the equivalent of Shift-F2 -- A dedicated window to review and edit the content. Unlike Shift-F2, this must be reusable.

I must mention that the form for showing details about a Member is also reusable. Following the plan above (which is abbreviated), I could have up to three Member forms and six Memo Entry forms open at once.

The solution below works well EXCEPT that the critical event UpdateComment() is only triggered once per Member-form instead of once per Memo-form. So if I open A and B for the same member and make edits, only one edit will be passed to the calling form.

Somehow I am failing to provide the calling form, Member Detail, with a method to treat the Memo forms as unique. How do I solve that?

Member Detail form -- this does the spawning

Dim strFieldName As String, varValue
Private WithEvents frmZoom As Form_frmMemberInputZoom

Private Sub btnView_A_Click()
    strFieldName = "boxQuality_A"
    varValue = Me(strFieldName)
    Call OpenMemberInput(Me!boxID, strFieldName, varValue, True)
End Sub

Private Sub btnView_B_Click()
    strFieldName = "boxQuality_B"
    varValue = Me(strFieldName)
    Call OpenMemberInput(Me!boxID, strFieldName, varValue, True)
End Sub

Private Sub frmZoom_UpdateComment(lngID As Long, _ 
                    strAssessStage As String, varReturn)

    Dim intCount As Integer
    For intCount = 1 To collectnZooms.Count
        If collectnZooms(intCount)![boxID] = lngID _
           And collectnZooms(intCount)![boxAssessStage] = strAssessStage _ 
              Then

                Me(strAssessStage) = varReturn
                Me.Dirty = False

                Exit Sub
        End If
    Next

End Sub

Private Sub Form_Close()
    Dim obj As Object

    For Each obj In collectnMembers
        If obj.Hwnd = Me.Hwnd Then
            collectnMembers.Remove CStr(Me.Hwnd)
        End If
    Next
End Sub

Sub OpenMemberInput(lngID As Long, strStage As String, _
                    varComment, booEdit As Boolean)

    Set frmZoom = New Form_frmMemberInputZoom

    frmZoom.Caption = CStr(frmZoom.Hwnd)

    frmZoom.ID = lngID 
    frmZoom.Stage = strStage
    frmZoom.ProviderName = "Dr " & CStr(lngID)
    frmZoom.Comment = varComment

    frmZoom.Visible = True

    collectnZooms.Add Item:=frmZoom, Key:=CStr(frmZoom.Hwnd)

End Sub

Memo Entry form -- this one is spawned

Public Event UpdateComment(lngID As Long, strAssessStage As String, _ 
                           varReturn)

Private lngAssess_ID As Long
Private strAssessStage As String
Private strProviderName As String
Private varComment

Public Property Let ID(ByVal MyAssessID As Long)
    lngAssess_ID = MyAssessID
    Me.boxID = lngAssess_ID
End Property

Public Property Let Stage(ByVal MyAssessStage As String)
    strAssessStage = MyAssessStage
    Me.boxAssessStage = strAssessStage
End Property

Public Property Let ProviderName(ByVal MyProviderName As String)
    strProviderName = MyProviderName
    Me.boxProviderName = strProviderName
End Property

Public Property Let Comment(ByVal varExisting)
    varComment = varExisting
    Me.boxComment = varComment
End Property

Public Property Get Comment()
    Comment = varComment
End Property

Private Sub boxComment_AfterUpdate()
    varComment = Me.boxComment
    Comment = varComment
End Sub

Private Sub Form_Close()

    '#################################################################
    ' Line below will be called for only ONE of the multiple instances
    '#################################################################

    RaiseEvent UpdateComment(lngAssess_ID, strAssessStage, varComment)

    Dim obj As Object
    For Each obj In collectnZooms
        If obj.Hwnd = Me.Hwnd Then
            collectnZooms.Remove CStr(Me.Hwnd)
        End If
    Next

End Sub

Upvotes: 3

Views: 383

Answers (1)

Smandoli
Smandoli

Reputation: 7019

As recommended in this post:

  • Dismantle the RaiseEvent function.
  • Use .Visible to avoid closing out the Memo Entry form (which throws things off).

Member Detail form -- this does the spawning

Dim strFieldName As String, varValue
'Private WithEvents ... NAH, WE WON'T GO THERE  

Private Sub btnView_A_Click()
    strFieldName = "boxQuality_A"
    varValue = Me(strFieldName)
    Call OpenMemberInput(Me!boxID, strFieldName, varValue, True)
End Sub

Private Sub btnView_B_Click()
    strFieldName = "boxQuality_B"
    varValue = Me(strFieldName)
    Call OpenMemberInput(Me!boxID, strFieldName, varValue, True)
End Sub

'Private Sub frmZoom_UpdateComment(lngID As Long, strAssessStage As String, varReturn)
'    ... NAH, we won't be using this...
'End Sub

Private Sub Form_Close()

    Dim obj As ObjecT
    For Each obj In collectnMembers
        If obj.Hwnd = Me.Hwnd Then
            collectnMembers.Remove CStr(Me.Hwnd)
        End If
    Next

End Sub

Sub OpenMemberInput(lngID As Long, strStage As String, _
                    varComment, booEdit As Boolean)

    Dim FoundMe As Boolean
    FoundMe = v_MemberComment.FetchForm(lngID, strStage)
    If FoundMe Then Exit Sub

    Dim frmZoom As New Form_frmMemberInputZoom

    Set frmZoom = New Form_frmMemberInputZoom


    frmZoom.ID = lngID 
    frmZoom.Stage = strStage
    frmZoom.Comment = varComment

    frmZoom.Visible = True

    collectnZooms.Add Item:=frmZoom, Key:=CStr(frmZoom.Hwnd)

End Sub

Memo Entry form -- this one is spawned

'' NAH, no use of the Public Event
'Public Event UpdateComment(lngID As Long, strAssessStage As String, varReturn)

Private lngAssess_ID As Long
Private strAssessStage As String
Private varComment

Public Property Let ID(ByVal MyAssessID As Long)
    lngAssess_ID = MyAssessID
    Me.boxID = lngAssess_ID
End Property

Public Property Let Stage(ByVal MyAssessStage As String)
    strAssessStage = MyAssessStage
    Me.boxAssessStage = strAssessStage
End Property

Public Property Let Comment(ByVal varExisting)
    varComment = varExisting
    Me.boxComment = varComment
End Property

Public Property Get Comment()
    Comment = varComment
End Property

Private Sub boxComment_AfterUpdate()
    varComment = Me.boxComment
    Comment = varComment
End Sub

Private Sub CmdCancel_Click()
    ''TODO revert to before-update text if Cancel is selected
    Me.Tag = "Cancel"
    Me.Visible = False
End Sub

Private Sub CmdOK_Click()

    Dim intCount As Integer, frm As Form, lngHwnd As Long
    For intCount = 1 To collectnMembers.Count

        Set frm = collectnMembers(intCount)
        If frm![boxID] = lngAssess_ID Then
                frm(strAssessStage) = varComment
                frm.Requery
        End If
    Next

    Me.Visible = False

End Sub

Private Sub Form_Close()

    'RaiseEvent .... NAH, DON'T BOTHER

    Dim obj As Object
    For Each obj In collectnZooms
        If obj.Hwnd = Me.Hwnd Then
            collectnZooms.Remove CStr(Me.Hwnd)
        End If
    Next
End Sub

VBA Standard Module to support above form

Public collectnZooms As New Collection

Public Function FetchForm(lngID As Long, strStage As String) As Boolean

    Dim intCount As Integer
    For intCount = 1 To collectnZooms.Count

        If collectnZooms(intCount)![boxID] = lngID _
           And collectnZooms(intCount)![boxAssessStage] = strStage Then
                FetchForm = True
                collectnZooms(intCount).Tag = ""

                collectnZooms(intCount).Visible = True

                Exit Function
        End If

    Next
End Function

Upvotes: 3

Related Questions