Meter un checkbox en datagrid

[fero]

Esto ejemplo usa lo más parecido a un checkbox en un datagrid que he visto.

Form con un datagrid DGrid y este código:

Option Explicit
Dim mRS As ADODB.Recordset
Dim CBCharacters(1) As String

Private Sub CreateRS()
Set mRS = New ADODB.Recordset
With mRS
.Fields.Append "ID", adInteger
.Fields.Append "Text", adVarWChar, 32
.Fields.Append "Bool", adBoolean
.LockType = adLockOptimistic
.Open
End With
End Sub

Private Sub FillRS(NumRecords As Long)
Dim RCount As Long

Select Case True
Case mRS Is Nothing
Case mRS.State And adStateOpen = adStateOpen
With mRS
RCount = .RecordCount + NumRecords
Do While .RecordCount < RCount
.AddNew
.Fields(0).Value = .RecordCount
.Fields(1).Value = Chr$(Int(65 * Rnd) + 65)
.Fields(2).Value = (.RecordCount Mod 2 = 0)
.Update
Loop
End With
End Select
End Sub

Private Sub DGrid_HeadClick(ByVal ColIndex As Integer)
mRS.Sort = mRS.Fields(ColIndex).Name
End Sub

Private Sub DGrid_KeyDown(KeyCode As Integer, Shift As Integer)
If DGrid.Col = 2 Then
KeyCode = 0
DGrid.Columns(2).Value = Not DGrid.Columns(2).Value
End If
End Sub

Private Sub DGrid_KeyPress(KeyAscii As Integer)
If DGrid.Col = 2 Then
KeyAscii = 0
End If
End Sub

Private Sub DGrid_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DGrid.RowContaining(Y) > -1 Then
If DGrid.ColContaining(X) > -1 Then
DGrid.Row = DGrid.RowContaining(Y)
End If
End If
End Sub

Private Sub DGrid_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DGrid.RowContaining(Y) > -1 Then
If DGrid.ColContaining(X) = 2 Then
DGrid.Columns(2).Value = Not DGrid.Columns(2).Value
End If
End If
End Sub

Private Sub Form_Load()
Dim DF As StdDataFormat
CBCharacters(0) = "."
CBCharacters(1) = "X"

CreateRS
FillRS 100
Set DGrid.DataSource = mRS
Set DF = New StdDataFormat
With DF
.Type = fmtBoolean
.FalseValue = CBCharacters(0)
.TrueValue = CBCharacters(1)
.NullValue = ""
End With
Set DGrid.Columns(2).DataFormat = DF
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Set DGrid.DataSource = Nothing
Select Case True
Case mRS Is Nothing
Case mRS.State And adStateOpen = adStateOpen
If mRS.EditMode <> adEditNone Then
mRS.Update
End If
mRS.Close
End Select
Set mRS = Nothing
End Sub

Private Sub Form_Resize()
DGrid.Move 90, 90, Me.ScaleWidth - 180, Me.ScaleHeight - 180
End Sub


Para mejorar esto y usar un checkbox "de verdad" habría que usar otro control (de terceros) como el Spread (FarPoint).