[AccessD] Controls created on the fly

Bill Benson (vbacreations) vbacreations at gmail.com
Thu May 13 22:07:05 CDT 2010


All, I got it to work ... with this simple example anyway.

Thanks. 


'FORM
Option Compare Database
Option Explicit
Dim g_AddedControl As clsAddedControl

Private Sub Command0_Click()
  Me.subfrm.SourceObject = ""
  AddControl "Subfrm"
  Me.subfrm.SourceObject = "Subfrm"
  Me.subfrm.Requery
  Set g_AddedControl = New clsAddedControl
  Set g_AddedControl.cbo = Me.subfrm.Form.Controls("cbo001")
End Sub
Private Sub Form_Load()
  Me.subfrm.SourceObject = ""
End Sub

'CLASS
Option Compare Database
Option Explicit
Private WithEvents AddedControl As Access.ComboBox
Private Sub AddedControl_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
   Debug.Print "MouseDown " & X & " " & Y
End Sub
Private Sub AddedControl_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
  Debug.Print "MouseMove " & X & " " & Y
End Sub
Private Sub AddedControl_MouseUp(Button As Integer, Shift As Integer, X As
Single, Y As Single)
    Debug.Print "Mouseup " & X & " " & Y
End Sub
Public Property Set cbo(ByVal IncomingControl As Control)
    If TypeOf IncomingControl Is ComboBox Then
      Set AddedControl = IncomingControl
    End If
End Property
Public Property Get cbo() As Access.ComboBox
    If Not AddedControl Is Nothing Then
      Set cbo = AddedControl
    End If
End Property


'STANDARD:
Sub AddControl(MyForm As String)
  Dim CtrlCBO As Control
  Dim frm As Form
  Dim InitialName As String
  
  On Error Resume Next
  DoCmd.DeleteObject acForm, MyForm
  On Error GoTo 0
  Set frm = CreateForm
  frm.HasModule = True
  InitialName = frm.Name
  Set CtrlCBO = CreateControl(frm.Name, acComboBox, , "", "", 10, 10)
  CtrlCBO.Name = "cbo001"
  CtrlCBO.RowSourceType = "Table/Query"
  CtrlCBO.RowSource = "Select Distinct DataField from Table1"
  CtrlCBO.Tag = "DDDragFunction=MyDragFrom;DDDropFunction=MyDropTo;Combo"
  CtrlCBO.OnMouseMove = "[Event Procedure]"
  CtrlCBO.OnMouseUp = "[Event Procedure]"
  CtrlCBO.OnMouseDown = "[Event Procedure]"
  DoCmd.Save acForm, InitialName
  DoCmd.Close acForm, InitialName, acSaveNo
  DoCmd.TransferDatabase acImport, "Microsoft Access", CurrentDb.Name, _
      acForm, InitialName, MyForm, False
  DoCmd.DeleteObject acForm, InitialName

End Sub




More information about the AccessD mailing list