Pastebin launched a little side project called HostCabi.net, check it out ;-)Don't like ads? PRO users don't see any ads ;-)
Guest

Multi Instance Form

By: a guest on Jun 6th, 2012  |  syntax: VB.NET  |  size: 3.03 KB  |  hits: 76  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Public mcolFormInstances As New Collection
  5.  
  6. Public Function CheckForFormInstance(strFormName As String, Optional strFilter As String) As Form
  7. On Error GoTo Err_Handler
  8.  
  9.     Dim i As Integer
  10.    
  11.     Set CheckForFormInstance = Form_Empty
  12.    
  13.     For i = 1 To mcolFormInstances.Count
  14.         If mcolFormInstances(i).Name = strFormName Then
  15.             If mcolFormInstances(i).Filter = strFilter Then
  16.                 Set CheckForFormInstance = mcolFormInstances(i)
  17.                 GoTo Code_Exit
  18.             Else
  19.                 Select Case strFormName
  20.                     Case "frmStudentList"
  21.                         Set CheckForFormInstance = mcolFormInstances(i)
  22.                         GoTo Code_Exit
  23.                 End Select
  24.             End If
  25.         End If
  26. Next_Loop:
  27.         If i = mcolFormInstances.Count Then
  28.             Exit For
  29.         End If
  30.     Next i
  31.  
  32. Code_Exit:
  33.     Exit Function
  34.  
  35. Err_Handler:
  36.     If Err.Number = 2467 Then ' object is broken
  37.         mcolFormInstances.Remove i
  38.         i = i - 1
  39.         GoTo Next_Loop
  40.     End If
  41.     DisplayUnexpectedError Err.Number, Err.Description
  42.     Resume Code_Exit
  43.     'Resume Next
  44. End Function
  45.  
  46. Public Sub CloseFormInstance(frm As Form)
  47. On Error GoTo Err_Handler
  48.    
  49.     mcolFormInstances.Remove CStr(frm.Hwnd)
  50.  
  51. Code_Exit:
  52.     Set frm = Nothing
  53.     Exit Sub
  54.    
  55. Err_Handler:
  56.     If Err.Number = 5 Then ' the hWnd key doesn't exist in mcolFormInstances
  57.        
  58.         Resume Code_Exit
  59.     End If
  60.     DisplayUnexpectedError Err.Number, Err.Description
  61.     Resume Code_Exit
  62.     'Resume Next
  63. End Sub
  64.  
  65. Public Function OpenFormInstance(strFormName As String, Optional strFilter As String) As Form
  66. On Error GoTo Err_Handler
  67.    
  68.     Dim frm As Form
  69.     Dim mdl As Module
  70.    
  71.     Set frm = CheckForFormInstance(strFormName, strFilter)
  72.    
  73.     If frm Is Form_Empty Then
  74.  
  75. ' THIS IS THE PART - START
  76.  
  77.         Select Case strFormName
  78.             Case "frmStudAgenda"
  79.                 Set frm = New Form_frmStudAgenda
  80.             Case "frmStudentList"
  81.                 Set frm = New Form_frmStudentList
  82.             Case "frmStudInfo"
  83.                 Set frm = New Form_frmStudInfo
  84.             Case "frmStudRecords"
  85.                 Set frm = New Form_frmStudRecords
  86.             Case "frmUnitInfo"
  87.                 Set frm = New Form_frmUnitInfo
  88.             Case Else
  89.                 DoCmd.OpenForm strFormName, , , strFilter
  90.                 GoTo Code_Exit
  91.         End Select
  92.  
  93. ' THIS IS THE PART - END
  94.        
  95.         If strFilter <> "" Then
  96.             frm.Filter = strFilter
  97.             frm.FilterOn = True
  98.         End If
  99.        
  100.         mcolFormInstances.Add Item:=frm, Key:=CStr(frm.Hwnd)
  101.        
  102.         frm.Visible = True
  103.     Else
  104.         frm.Visible = True
  105.         frm.SetFocus
  106.     End If
  107.  
  108. Code_Exit:
  109.     Set OpenFormInstance = frm
  110.     Set frm = Nothing
  111.     Exit Function
  112.  
  113. Err_Handler:
  114.     DisplayUnexpectedError Err.Number, Err.Description
  115.     Resume Code_Exit
  116.     'Resume Next
  117. End Function