Selectievakjes beheren in dezelfde groep

[gonzo31]

Goedendag,

Ik heb een excel file met daarin 3 verschillende groepen selectievakjes (checkboxes). Boven elke groep staat een Alles-vakje.
Nu wil ik graag in VBA een code schrijven, dat als ik het Alles-vakje aanklik, alle andere in dezelfde groep geselecteerd dan wel gedeselecteerd worden.
Ook wil ik dat het selectievakje een intermediate status aanneemt (grijs vlakje) als sommige vakjes in de groep wel en andere niet geselecteerd zijn.

Ik heb de onderstaande code. Probleem is, deze werkt prima als ik de boel niet in groepen heb verdeeld maar dus niet na het groeperen.

Sub BG_SelectAll_Click()

Dim CB As CheckBox

For Each CB In ActiveSheet.CheckBoxes

  If CB.Name <> ActiveSheet.CheckBoxes("BG").Name Then
    CB.Value = ActiveSheet.CheckBoxes("BG").Value
  
  End If

Next CB

End Sub
-------------------------------------------------------------------------------------------------------------------------------
Sub BG_Mixed_State()

Dim CB As CheckBox

For Each CB In ActiveSheet.CheckBoxes
  
  If CB.Name <> ActiveSheet.CheckBoxes("BG").Name And CB.Value <> ActiveSheet.CheckBoxes("BG").Value And ActiveSheet.CheckBoxes("BG").Value <> 2 Then
    ActiveSheet.CheckBoxes("BG").Value = 2

Exit For
   
   Else
     ActiveSheet.CheckBoxes("BG").Value = CB.Value
  
  End If

Next CB

End Sub

De naam van het Alles-vakje is "BG"
De groep heet "grpBG"
De rest van de vakjes in de groep heten "chkbox1", "chkbox2", "chkbox3", "chkbox4", "chkbox5".
De "Sub BG_SelectAll_Click()" hangt als macro aan selectievakje "Alles"
De "Sub BG_Mixed_State()" hangt als macro aan alle overige vakjes in de groep.
Tot slot, het zijn formulier-vakjes dus geen ActiveX.

Als het voor één groep werkt, dan kan ik het natuurlijk zelf aanpassen voor de andere groepen
Hoop dat er iemand kan helpen.

Arjan

 

[HSV]

Misschien is het niet onverstandig om het bestand bij te sluiten.

 

[gonzo31]

Ja, dat is wellicht wel handig.

Tadaaa
Bekijk bijlage Voorbeeld - De goede!.xlsm

 

[wieter]

Ben je hier iets mee?

Bekijk bijlage Alle chckbxn selecteren.xlsm

Intermediate status kan ik niet

 

[gonzo31]

Hi 'wieter',

Ja, daar kan ik wel wat mee. Ik had het liever per groep gehad, dat valt makkelijker uit te breiden naar wat groters maar dit werkt ook.
Bedankt voor deze oplossing!

------------

Het erge is, ik had dit allemaal al een keer werkend maar verkeerd opgeslagen. Project tijdelijk op de zijlijn, nu weer opgepakt en hoppa, niets van geleerd, kennis dus weg en in de problemen. Gelukkig bestaat het helpmij forum!

Arjan

 

[gonzo31]

Iemand nog een oplossing om dit per groep aan te sturen?

En daarnaast het alles-vakje de internediate state te geven (value = 2)?

Bij voorbaat dank!

 

[HSV]

Hoe zijn ze nu gegroepeerd?
Ik kan het nergens ontdekken.
Misschien Excel versie verschil?

 

[sylvester-ponte]

Harry met de rechter muis op een selectievak je klikken.....

 

[HSV]

Hallo Sylvester,

Dat had ik al gedaan, maar zie nergens de naam "BG".
Excel 2007.

 

[gonzo31]

Sorry, Excel 2013 hier.

Wellicht staat het nog op de plek waar je cellen een naam kan geven?
In Excel 2013 staat het hier:

 

[HSV]

Dag Arjan,

Ik werk met Excel 2007, en daardoor zijn niet zichtbaar.
Ik heb het even gereproduceerd, en hier werkt het.
Je wil niet weten hoeveel uren ik er in heb gestoken en hoe vaak ik het heb weggelegd.

Sub hsv()
 Dim sh As Shape, grp As String, j As Long, i As Long, cb As Object, arr() As Variant
  grp = ActiveSheet.Shapes(Application.Caller).ParentGroup.Name
    For Each sh In ActiveSheet.Shapes
      If sh.Name = grp Then
      If sh.Type = msoGroup Then
    ReDim arr(0 To sh.GroupItems.Count - 1) As Variant
 For j = 0 To sh.GroupItems.Count - 1
       arr(j) = sh.GroupItems(j + 1).Name
     Next j
Set cb = ActiveSheet.Shapes.Range(arr)
         For i = 1 To sh.GroupItems.Count
            If i = 1 Then cb.ParentGroup.Ungroup
        cb(i).ControlFormat.Value = xlOff
      Set cb = ActiveSheet.Shapes.Range(arr)
   Next i
         cb.Regroup.Name = grp
       End If
     End If
   Next sh
 End Sub

 

[gonzo31]

Bedankt HSV! Aan het script te zien was dit inderdaad geen eenvoudige. Ik ben de komende dagen helaas weg van mijn computer maar zodra ik terug ben laat ik weten of het ook bij mij werkt. Hartelijk dank in ieder geval voor de tijd die je er in hebt gestoken.

Arjan