4/5 (12 avis)
Vue 14 384 fois - Téléchargée 1 951 fois
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
7 janv. 2013 à 15:50
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
24 févr. 2010 à 12:39
17 avril 2008 à 15:37
14 avril 2008 à 01:13
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 !
13 avril 2008 à 12:44
Juste une question:
Ça sert à quoi, si on n'arrive pas à mettre à jour la base?
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.