Checkbox.add VBA

Florian53

XLDnaute Impliqué
Bonjour à tous,

Je voudrais insérer des chexbox automatiquement en fonction des résultats d'une ligne.
J'essaye d'insérer les checkbox à partir de ligne 28 mais ça ne fonctionne pas.
Pouvez vous m'aider svp ?
merci
 

Pièces jointes

  • cases à cocher.xlsm
    16.2 KB · Affichages: 30

Florian53

XLDnaute Impliqué
J'ai réussi à faire ça , sa fonctionne mais toutes les checkboxes se mettent les unes sur les autres a lors que je l'ai voudrait les unes en dessous des autres.

VB:
Sub CréerCase()
Dim Cellule As Range
Dim wsResult As Object

Set wsResult = Worksheets("Feuil1")
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column
With wsResult.Range("C2:C" & dercol)

For Each Cellule In Cells(25 + i, 1)
For i = 3 To dercol
  With Cellule
  ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
  End With
  With Selection
    '.LinkedCell = Cellule.Offset(0, 1).Address
    .Characters.Text = Cells(2, i).Value
  End With
  Next i
Next Cellule

End With

End Sub
 

Pièces jointes

  • cases à cocher.xlsm
    16.2 KB · Affichages: 36

Florian53

XLDnaute Impliqué
Je pense avoir réussi avec ce code:

VB:
Sub CréerCase()
Dim Cellule As Range
Dim wsResult As Object

Set wsResult = Worksheets("Feuil1")
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Offset(0, 0).Column
With wsResult.Range("C2:C" & dercol)

For i = 3 To dercol
For Each Cellule In Range("A" & i + 25)

  With Cellule
  ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
  End With
  With Selection
    '.LinkedCell = Cellule.Offset(0, 1).Address
    .Characters.Text = Cells(2, i).Value
  End With
 
Next Cellule
Next i

End With

End Sub
Pouvez vous me dire si vous voyez des erreurs ?
 

Florian53

XLDnaute Impliqué
Merci Pierrejean, sa me convient, je voudrais rajouter une option que je n'arrive pas à appliquer:

je voudrais que lorsque j'appuie sur une checkbox sa masque la colonne en question, pr exemple la chexbox A = true ==> la colonne "C" masqué.

j'ai essayé avec ceci mais ça ne fonctionne pas:

VB:
Sub CréerCase()
Dim Cellule As Range
Dim wsResult As Object

Set wsResult = Worksheets("Feuil1")

With wsResult
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
i = 3
ligne = 26
For Each Cellule In .Range("C3:C" & dercol)
     Set CellDest = Cells(ligne, 1)
     ligne = ligne + 1
    With CellDest
      ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
    End With
  With Selection
    .LinkedCell = Columns(ligne).Hidden
    .Characters.Text = Cells(2, i).Value
     i = i + 1
  End With
Next Cellule
End With
End Sub

et est ce possible de vérifier que les checkboxes ne sont pas déjà présentes afin de ne pas en re créé ?

merci Pierrejean
 

Florian53

XLDnaute Impliqué
Merci Pierrejean,

je voudrais plutot qu'il me masque la colonne ou apparait le "A" c'est à dire la colonne "C" quand je clique sur la checkbox "A".

j'ai essayé ceci mais sa bloque sur "Case":

VB:
Sub CréerCase()
Dim Cellule As Range
Dim wsResult As Object

Set wsResult = Worksheets("Feuil1")

With wsResult
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
i = 3
ligne = 26
   For Each ch In ActiveSheet.CheckBoxes
      ch.Delete
  Next
For Each Cellule In .Range("C3:C" & dercol)
     Set CellDest = Cells(ligne, 1)
     ligne = ligne + 1
    With CellDest
      ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
    End With
  With Selection
    .OnAction = "clic"
    .Characters.Text = Cells(2, i).Value
    .Name = "Case" & i
     i = i + 1
  End With
Next Cellule
End With
End Sub


Sub clic()
Dim i As Integer
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column

For i = 3 To dercol
If CheckBoxes("Case" & i).Value = 1 Then
    Columns(i).Hidden = True
Else
     Columns(i).Hidden = False
End If
Next i
End Sub
 
Dernière édition:

Florian53

XLDnaute Impliqué
merci PierreJean du coup je l'ai adapté à l'inverse ( True - False ):

VB:
Sub CréerCase()
Dim Cellule As Range
Dim wsResult As Object
Set wsResult = Worksheets("Feuil1")
With wsResult
dercol = Cells(2, Cells.Columns.Count).End(xlToLeft).Column
i = 3
ligne = 26
   For Each ch In ActiveSheet.CheckBoxes
      ch.Delete
  Next
For Each Cellule In .Range("C3:C" & dercol)
     Set CellDest = Cells(ligne, 1)
     ligne = ligne + 1
    With CellDest
      ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
    End With
  With Selection
    .OnAction = "clic"
    .Characters.Text = Cells(2, i).Value
    .Value = True
     i = i + 1
  End With
Next Cellule
End With
End Sub
Sub clic()
Application.ScreenUpdating = False
ActiveSheet.Columns.Hidden = False
For Each ch In ActiveSheet.CheckBoxes
  Set c = ActiveSheet.Rows(2).Find(ch.Caption, LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    If ch.Value = 1 Then
       Columns(c.Column).Hidden = False
     Else
       Columns(c.Column).Hidden = True
     End If
   End If
Next
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

  • Résolu(e)
Microsoft 365 planning
Réponses
4
Affichages
176

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo