Change ControlType

Ever tried changing the controltype of various controls into others? Easy, right-click and select another type.

But for a change from textbox (or listbox, combobox) into a checkbox (or other toggle-like control). Bummer. Makes sense, though: the field type is different.

Maybe you do want to have a checkbox on a text field. You could store two textual values into the field.

The setShadow routine below will handle the conversion. Please note that the original control is not deleted. You may call this routine when cycling all controls on a form, and deleting a control disturbes the Controls collection.

Sub setShadow(ctl As Control)
'changes the control into a Checkbox
Dim F As Form
Dim lbl As Label
Dim cName As String
Dim nLeft As Single, nTop As Single
Dim cCaption As String
Dim nLLeft As Single, nLTop As Single
   Set F = ctl.Parent
   cName = ctl.name
   ctl.name = ctl.name & "_deprecated"
   ctl.Visible = False
   nLeft = ctl.Left
   nTop = ctl.top
   If ctl.Controls.Count > 0 Then
      With ctl.Controls(0)
         cCaption = .Caption
         nLLeft = .Left
         nLTop = .top
      End With
   End If
   Set ctl = CreateControl(F.name, acCheckBox, ctl.Section, , ctl.ControlSource)
   ctl.name = cName
   ctl.Left = nLeft
   ctl.top = nTop
   Set lbl = CreateControl(F.name, acLabel, ctl.Section, cName)
   lbl.Left = nLLeft
   lbl.top = nLTop
   lbl.Caption = cCaption
   lbl.SizeToFit
   Set lbl = Nothing
End Sub

Now, for this checkbox to store sensible values, you need to have it unbound. My routine unBind will handle this:

Sub unBind(ctl As CheckBox, cPar As String)
'implement checkbox on values other than true/false
' create unbound checkbox; handle read with Form_Current; handle write with Control_Click
Dim M As Module
Dim nLine As Long
Dim cVeld As String
Dim cVBA As String
   cVeld = ctl.ControlSource
   DoCmd.OpenModule , "form_" & ctl.Parent.name
   Set M = Modules("form_" & ctl.Parent.name)
   'handle read
   If M.Find("form_current", nLine, 0, M.CountOfLines, 999) Then
      'extend event
   Else
      'create event
      nLine = M.CreateEventProc("Current", ctl.Parent.name)
   End If
   cVBA = vbTab & ctl.name & " = (" & cVeld & "='" & getFirstOf(cPar) & "')"
   M.InsertLines nLine + 1, cVBA
   'handle write
   If M.Find(ctl.name & "_click", nLine, 0, M.CountOfLines, 999) Then
   Else
      nLine = M.CreateEventProc("Click", ctl.name)
   End If
   cVBA = vbTab & cVeld & " = iif(" & ctl.name & ",'" & getFirstOf(cPar) & "','" & getLastOf(cPar) & "')"
   M.InsertLines nLine + 1, cVBA
   DoCmd.Close acModule, M.name, acSaveYes
   Set M = Nothing
   'actual unbind
   ctl.ControlSource = ""
End Sub

Two helper routines have been created:

Function getFirstOf(cList As String, Optional cSeparator = ";") As String
Dim nPos As Long
   nPos = InStr(cList, cSeparator)
   If nPos = 0 Then
      getFirstOf = cList
   Else
      getFirstOf = Left(cList, nPos - 1)
   End If
End Function

Function getLastOf(cList As String, Optional cSeparator = ";") As String
Dim nPos As Long
   nPos = InStr(cList, cSeparator)
   If nPos = 0 Then
      getLastOf = cList
   Else
      getLastOf = MID(cList, nPos + 1)
   End If
End Function

I have used a collection to temporarily hold the controls to be deleted:

Dim kills As Collection
Dim obj As Object

   If ctl.ControlType <> acCheckBox Then
      kills.Add ctl
      setShadow ctl
   End If
   If cParameters <> "" Then
      unBind ctl, cParameters
   End If

   For Each obj In kills
      DeleteControl cForm, obj.name
   Next