Datagrid + checkbox

Soyez le premier à donner votre avis sur cette source.

Vue 14 256 fois - Téléchargée 1 935 fois

Description

Voici la source du tutoriel :
http://www.vbfrance.com/tutoriaux/DATAGRID-AVEC-CHECKBOX_834.aspx

Comme il m'a été demandé à plusieurs reprise voici donc la source fonctionnel.

Source / Exemple :


Option Explicit

Private bInSetCheckboxes As Boolean

Private Sub Form_Activate()
    SetCheckboxes 1, cbTest        'Ici 1 représente la 2e colonne du DataGrid
End Sub

Private Sub SetCheckboxes(ColNdx As Long, ByRef ChkboxArray As Object)
    bInSetCheckboxes = True
    
    On Error GoTo ErrorExit
    Dim i
    Dim obj As Object
    Set obj = dgTest
    Dim OffsetX As Long, OffsetY As Long
    
    If Not ChkboxArray(0).Container Is dgTest.Container Then
        CalcContainerOffset obj, OffsetX, OffsetY
    End If

    On Error Resume Next

    With dgTest

        If (ChkboxArray.UBound <> .VisibleRows) Then
            For i = ChkboxArray.UBound + 1 To .VisibleRows - 1
                Load ChkboxArray(i)
                ChkboxArray(i).Width = 190
                ChkboxArray(i).Height = 190
            Next
            For i = .VisibleRows To ChkboxArray.UBound
                
            Next
        End If
    
        OffsetX = OffsetX + (.Columns(ColNdx).Width - ChkboxArray(0).Width) / 2
        OffsetY = OffsetY + 10 ''(.RowHeight - ChkboxArray(0).Height) / 2
        
        .Columns(ColNdx).Alignment = dbgCenter
        .Columns(ColNdx).Locked = True
    
        If .LeftCol <= ColNdx Then
            For i = 0 To .VisibleRows - 1
                ChkboxArray(i).Value = Abs(.Columns(ColNdx).CellValue(.RowBookmark(i)))
                ChkboxArray(i).Top = .Top + .RowTop(i) + OffsetY
                ChkboxArray(i).Left = .Left + .Columns(ColNdx).Left + OffsetX
                ChkboxArray(i).Visible = True
                ChkboxArray(i).ZOrder
            Next
        Else
            i = 0
        End If
    
        For i = i To ChkboxArray.UBound
            ChkboxArray(i).Visible = False
        Next
    End With

ExitPoint:
    bInSetCheckboxes = False
    Exit Sub
ErrorExit:
    Resume ExitPoint
End Sub

Private Function CalcContainerOffset(obj As Object, ByRef OffsetX As Long, ByRef OffsetY As Long)
    Do While Not (obj.Container Is obj.Parent)
        Set obj = obj.Container
        If Not (obj Is Nothing) Then
            OffsetX = OffsetX + obj.Left
            OffsetY = OffsetY + obj.Top
            If obj.BorderStyle = 1 Then '' fixed single
                If obj.Appearance = 1 Then '' 3d
                    OffsetX = OffsetX + 30
                    OffsetY = OffsetY + 30
                Else
                    OffsetX = OffsetX + 15
                    OffsetY = OffsetY + 15
                End If
            End If
        End If
        If (TypeOf obj Is Form) Or (TypeOf obj Is MDIForm) Then Exit Do
  Loop
End Function

Private Sub dgTest_Scroll(Cancel As Integer)
    SetCheckboxes 1, cbTest        'Ici 1 représente la 2e colonne du DataGrid
End Sub

Private Sub cbTest_Click(index As Integer)
    Dim fr As Long
    On Error Resume Next
    fr = dgTest.FirstRow
    With adoTemp.Recordset        'Ici j?utilise un ado mais vous pouvez utilize n?importe quel type de recordset ce bout de code ne doit donc pas être recopié tel quel. Ce code met à jour le champs attaché au checkbox avec la bonne valeur, ce champs doit etre de type boolean donc si vous utilisé SQL SERVER vous devez utilisé un colonne de type BIT.
        .Filter = "LineID='" & index + fr & "'"
        .Fields("Include").Value = cbTest(index).Value
        .UpdateBatch
        .Filter = "LineID<>''"
        .Resync
    End With
    dgTest.FirstRow = fr
    'Fin du code que vous devez adapter.
End Sub

Conclusion :


En espérant que cette source puisse vous aidez.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
17
Date d'inscription
mardi 3 juin 2008
Statut
Membre
Dernière intervention
7 janvier 2013

Bonjour,
petite question
ce if fait quoi exactement
If Not ChkboxArray(0).Container Is dgTest.Container Then
CalcContainerOffset obj, OffsetX, OffsetY
End If
On Error Resume Next
quand j'implemente cet exemple dans mon form, il entre pas dans le if et saute directement vers
Resume ExitPoint
Messages postés
30
Date d'inscription
lundi 11 janvier 2010
Statut
Membre
Dernière intervention
2 août 2010

Merci beaucoup pour ce code!!! Je voulais savoir au passage si il était possible d'afficher le texte correspondant aux cases cochées (dans le datagrid) à l'intérieur de plusieurs textbox qui apparaitraient dans un autre form?
Messages postés
584
Date d'inscription
jeudi 28 décembre 2006
Statut
Membre
Dernière intervention
29 avril 2010
1
j'avais mis cette ligne en commentaire parce que je ne modifie pas la hauteur de mes lignes donc mes trucs etaient deja centrer...
Messages postés
1402
Date d'inscription
mardi 1 mai 2007
Statut
Membre
Dernière intervention
7 octobre 2012
5
Salut Chrysostome,
Si si, la table est mise à jour grace à :
Private Sub cbTest_Click(index As Integer)
Dim fr As Long
On Error Resume Next
fr = dgTest.FirstRow
With adoTemp.Recordset
.Filter = "LineID='" & index + fr & "'"
.Fields("Include").Value = cbTest(index).Value
.UpdateBatch
.Filter = "LineID<>''"
.Resync
End With
dgTest.FirstRow = fr
'Fin du code que vous devez adapter.
End Sub

@Zen69
Pour le centrage j' ai réactivé le reste de la ligne que tu as mis en commentaire(je ne sais pas pourquoi , dailleur)
OffsetY = OffsetY + (.RowHeight - ChkboxArray(0).Height) / 2

et ça marche !
Messages postés
121
Date d'inscription
vendredi 17 octobre 2003
Statut
Membre
Dernière intervention
14 octobre 2016

Salut!
Juste une question:
Ça sert à quoi, si on n'arrive pas à mettre à jour la base?
Afficher les 12 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.