XL 2019 Fichier inscription VBA

  • Initiateur de la discussion Initiateur de la discussion Richard 58
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Richard 58

XLDnaute Nouveau
Bonjour,
J'ai un niveau plus que faible en codage VBA.
J'ai un fichier qui me permet d'inscrire des enfants à des activités pour cette été. Je peux faire la somme des tarifs des différentes activités, bloquer les activités quand elle est pleine, imprimer la liste des participants par activités.
J'ai 104 checkbox pour les activités et 2 autre pour le mode de paiement. Actuellement mon fichier ne fonctionne pas et je ne sais pas pourquoi, j'ai donc besoin de votre aide.
Je met les différentespartie du code ci dessous :
Code:
Private Sub UserForm_Initialize()
  Dim x%, iNb%, sCol$
  Dim I As Integer, M As String


  ' Instancier les évènements des Checkbox
  For I = 1 To 104
    Set Chk(I).Chk = Me("Checkbox" & I)
  Next I

ComboBox1.RowSource = "Menu!A2:A3"
ComboBox2.RowSource = "Menu!B2:B3"
'
With Worksheets("Enfant")
    For x = 1 To 104
        sCol = Split(.Columns(x + 20).Address(ColumnAbsolute:=False), ":")(1)
        iNb = WorksheetFunction.CountIf(.Range(sCol & "3:" & sCol & .Range(sCol & .Rows.Count).End(xlUp).Row), "X")
        Me.Controls("CheckBox" & x).Enabled = IIf(iNb >= .Range(sCol & 3).Value, False, True)
        Me.Controls("CheckBox" & x).Value = False
        Me.Controls("lNb" & x).Caption = CStr(.Range(sCol & 3).Value - iNb)
    Next
End With


End Sub

Pour créer le nouvel inscrit :
Code:
'Pour le bouton Nouveau contact Enfant
Private Sub CommandButton1_Click()
'
Dim x%, L%, iT%, iC%, iCB%
'
If MsgBox("Confirmez-vous l’insertion de cette nouvelle inscription ?", vbYesNo, "Demande de confirmation d’ajout") = vbYes Then
    With Worksheets("Enfant")
        L = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
        If L < 5 Then L = 5
        For x = 1 To 128
            Select Case x
                Case 1, 2, 3, 6 To 20, 126
                    iT = iT + 1
                    .Cells(L, x) = Me.Controls("TextBox" & iT).Text
                Case 4, 5
                    iC = iC + 1
                    .Cells(L, x) = Me.Controls("ComboBox" & iC).Text
                Case 21 To 124, 127, 128
                    iCB = iCB + 1
                    .Cells(L, x) = IIf(Me.Controls("CheckBox" & iCB).Value = True, "X", "")
            End Select
        Next
        .Cells(L, 125).FormulaLocal = "=NB.SI(u" & L & ":dt" & L & ";""X"")"
        .Cells(L + 1, 125).Resize(1, 2).Delete shift:=xlUp
        .Cells(L + 2, 125).FormulaLocal = "=SOMME(DU4:DU" & L & ")"
        .Cells(L + 2, 126).FormulaLocal = "=SOMME(DV4:DV" & L & ")"
        .Cells(L + 2, 125).Resize(1, 2).Borders.LineStyle = 1
    End With
    Call InitFormulaire
End If
'
End Sub
Pour le formulaire :
Code:
Public Sub InitFormulaire()
'
Dim x%, iNb%, iT%, iC%, iCB%, sCol$


With Worksheets("Enfant")
    For x = 1 To 104
        sCol = Split(.Columns(x + 210).Address(ColumnAbsolute:=False), ":")(1)
        iNb = WorksheetFunction.CountIf(.Range(sCol & "3:" & sCol & .Range(sCol & .Rows.Count).End(xlUp).Row), "X")
        Me.Controls("CheckBox" & x).Enabled = IIf(iNb >= .Range(sCol & 3).Value, False, True)
        Me.Controls("CheckBox" & x).Value = False
        Me.Controls("lNb" & x).Caption = CStr(.Range(sCol & 3).Value - iNb)
    Next
End With
 For x = 1 To 128
            Select Case x
                Case 1, 2, 3, 6 To 20, 126
                    iT = iT + 1
                    Me.Controls("TextBox" & iT).Text = ""
                Case 4, 5
                    iC = iC + 1
                    Me.Controls("ComboBox" & iC).Text = ""
                Case 21 To 124, 127, 128
            iCB = iCB + 1
            Me.Controls("CheckBox" & iCB).Value = False
    End Select
Next
Me.TextBox1.SetFocus
'
End Sub

J'ai fait une recherche sur les checkbox avec
Code:
' en cas d'erreur
  On Error GoTo Erreur_Proc
 
  Erreur_Proc:
  MsgBox "Erreur, le checkbox n° " & I & " n'existe pas !"
  Resume Next

Il me dit que la 105 n'existe pas alors qu'elle est bien présente.
Autre problème la textbox21 ne s'affiche pas en case 126

Merci pour votre aide.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
599
Réponses
4
Affichages
361
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
78
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
250
Réponses
7
Affichages
98
Réponses
3
Affichages
239
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
500
Réponses
2
Affichages
375
Réponses
2
Affichages
405
Retour