XL 2016 Probleme de code

Richard 58

XLDnaute Nouveau
Bonjour,
Une erreur est présent dans mon code, je n'arrive pas à la résoudre.
Je ne maitrise pas du tout le VBA, à chaque fois que je fais un fichier je suis dans l'approximation et le tâtonnement. J'ai donc besoin de vous.
VB:
Option Explicit

Dim f As Worksheets, cell As Range
Dim no_ligne&, n&, ln&, i&, j&, flag&

'Pour le bouton Créer
Private Sub CommandButton1_Click()

    Set cell = f.Range("A:B").Find(TextBox1, TextBox2, lookat:=xlWhole)
    If Not cell Is Nothing Then
        MsgBox "L'adhérent " & TextBox1 & " existe déjà. Vous ne pouvez que la modifier.", 16
        Exit Sub
    End If
    If MsgBox("Confirmez-vous l’insertion de cet adhérent ?", vbYesNo, "Demande de confirmation d’ajout") = vbYes Then
        ln = f.Range("a65536").End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
        For j = 1 To 50
        Select Case j
        Case 1, 2, 4 To 6, 8 To 12, 15 To 28, 41 To 45, 49
            f.Cells(ln, j) = Controls("TextBox" & j).Value
        Case 3, 7, 39, 40, 50
            f.Cells(ln, j) = Controls("ComboBox" & j).Value
        Case 13, 14, 29 To 38, 46, 47
            f.Cells(ln, j) = Controls("CheckBox" & j).Value
        End Select
        
        Next j
        f.Range(f.Cells(3, 1), f.Cells(f.Range("A" & Rows.Count).End(xlUp).Row, f.Cells(2, Columns.Count).End(xlToLeft).Column)).Sort _
                key1:=f.Range("A3"), order1:=xlAscending, Header:=xlNo
    Else
        Exit Sub
    End If
    MsgBox "L'adhérent''" & TextBox1 & " a été créée."
    Unload Me
    UserForm1.Show
End Sub


'pour le bouton supprimer
Private Sub CommandButton2_Click()
    
    If TextBox1 = "" Then Exit Sub
    If MsgBox("Confirmez-vous la suppression de la fiche " & TextBox1 & " ?", vbYesNo, "La suppression a été prise en compte.") = vbYes Then
        With Sheets("Adhérent")
            ln = .Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Find(TextBox1, lookat:=xlWhole).Row
            .Rows(ln & ":" & ln).Delete Shift:=xlUp
        End With
    Else
        Exit Sub
    End If
    MsgBox "La fiche " & TextBox1 & " a été supprimée."
    Unload Me
    UserForm1.Show
End Sub

'Pour le bouton Quitter
Private Sub CommandButton3_Click()
    Unload Me
End Sub

'pour le bouton Modifier
Private Sub CommandButton4_Click()
    
    If TextBox1 = "" Then Exit Sub
    If MsgBox("Confirmez-vous la modification de la fiche " & TextBox1 & " ?", vbYesNo, "La modification a été prise en compte.") = vbYes Then
        ln = f.Range("A3:A" & f.Range("A" & Rows.Count).End(xlUp).Row).Find(ComboBox1, lookat:=xlWhole).Row
        flag = 1
       For j = 1 To 50
        Select Case j
        Case 1, 2, 4 To 6, 8 To 12, 15 To 28, 41 To 45, 49
            f.Cells(ln, j) = Controls("TextBox" & j).Value
        Case 3, 7, 39, 40, 50
            f.Cells(ln, j) = Controls("ComboBox" & j).Value
        Case 13, 14, 29 To 38, 46, 47
            f.Cells(ln, j) = Controls("CheckBox" & j).Value
        End Select
        Next j
        flag = 0
    End If
    MsgBox "La fiche " & TextBox1 & " a été modifiée."
    Unload Me
    UserForm1.Show
End Sub
'Pour rechercher
Private Sub ComboBox1_Change()

    If flag = 1 Then Exit Sub
    If ComboBox1 = "" Then Exit Sub
    If Not ComboBox1.Value = "" Then
        no_ligne = ComboBox1.ListIndex + 3
        For n = 1 To 50
            Controls("TextBox" & n) = f.Cells(no_ligne, n).Value
        Next n
    Else
        MsgBox "Vous devez choisir un nom.", 16
        Exit Sub
    End If
End Sub
 

Pièces jointes

  • Copie de Inscription.xlsm
    39 KB · Affichages: 18
Solution
Bonjour,

Ci-joint une version modifié de ton fichier qui ne doit pas être loin de ce que tu souhaites.
Il y avait plusieurs problèmes, entre autres le nom erroné de la procédure UserForm_initialize, et des erreurs dans l'initialisation des ComboBox ainsi que plein de petites choses à droite ou à gauche.
J'ai fait pas mal de modifs, mais j'ai gardé la structure générale de ton code. La Combobox de recherche inclut maintenant le nom et le prénom (dans la liste).
Je n'ai probablement pas tout testé. Regarde si tout est ok et si cela te convient.
Reviens pour explications ou modifications.

Cordialement

ALS35

XLDnaute Impliqué
Bonjour,

Ta variable f est mal déclarée, il faut Dim f as Worksheet (et non Worksheets) et pas initialisée par un Set f = Sheets("Adhérent"). Mais en fait tu n'en a pas vraiment besoin car tu travailles a priori toujours sur la feuille active.
Ensuite tu as un souci sur l'instruction Find avec deux critères, et après un problème de numéro de Control

Cordialement
 

ALS35

XLDnaute Impliqué
Merci pour ton retour, mais comme je l'ai dit je ne maitrise pas grand chose. Peux tu me montrer tes corrections ?
Re,
Un début de correction dans ton fichier modifié. Mais après il faut que tu nommes tes différents Controls conformément au numéro de colonne dans lequel tu veux enregistrer tes infos. Exemple le Nom est en colonne 1, le control doit se nommer Textbox1, le pays est en colonne 6, le Control doit se nommer Textbox6, etc..
Tu as du boulot

Cordialement
 

Pièces jointes

  • XLD Inscription modifié.xlsm
    34.9 KB · Affichages: 7

Richard 58

XLDnaute Nouveau
J'ai revu ma copie. Mais il reste plusieurs erreurs.
  1. Les texbox et les checkbox se place correctement dans le tableau excel, par contre pas les combo. Je n'arrive pas à régler le probleme.
  2. Je n'arrive pas avoir les colonne a et B dans le texbox 1 qui permet de rechercher un nom + prénom
  3. le bouton modifier ne fonction pas
  4. le bouton supprimer ne fonctionne pas
  5. Les combo ne s'initialise pas via le code mais uniquement via la propriété de la combo
Ce fichier doit me permettre d'inscrire les adhérent de mon club afin d'avoir toutes les données qui nous sont nécessaires sur un seul et même tableau. Je dois être capable de rechercher un nom entrainant de voir toutes les données dans userform, corriger les erreurs et modifier la fiche.

Je joins ma nouvelle version et mon nouveau code
VB:
Option Explicit

Dim cell As Range
Dim x%, L%, iT%, iC%, iCB%, flag%


'Pour le bouton Créer
Private Sub CommandButton1_Click()
Set cell = Range("A:A").Find(TextBox1, lookat:=xlWhole)
    If Not cell Is Nothing Then
        MsgBox "L'association " & TextBox1 & " " & TextBox2 & "existe déjà. Vous ne pouvez que la modifier.", 16
        Exit Sub
    End If

      If MsgBox("Confirmez-vous l’insertion de cet adhérent ?", vbYesNo, "Demande de confirmation d’ajout") = vbYes Then
    With Worksheets("Adhérent")
        L = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
        If L < 3 Then L = 3
        For x = 1 To 50
        Select Case x
        Case 1, 2, 4 To 6, 8 To 12, 15 To 28, 42 To 46, 50
        iT = iT + 1
            .Cells(L, x) = Controls("TextBox" & iT).Text
        Case 3, 7, 39, 40, 49
        iC = iC + 1
            .Cells(L, x) = Controls("ComboBox" & iC).Text
        Case 13, 14, 29 To 38, 47, 48
        iCB = iCB + 1
            .Cells(L, x) = IIf(Me.Controls("CheckBox" & iCB).Value = True, "X", "")
        End Select
        
        Next x
        .Range(.Cells(3, 1), .Cells(.Range("A" & Rows.Count).End(xlUp).Row, .Cells(2, Columns.Count).End(xlToLeft).Column)).Sort _
                key1:=.Range("A3"), order1:=xlAscending, Header:=xlNo
    End With
    Else
        Exit Sub
    End If
    MsgBox "L'adhérent''" & TextBox1 & " a été créée."
    Unload Me
    UserForm1.Show
End Sub


'pour le bouton supprimer
Private Sub CommandButton2_Click()
    
    If TextBox1 = "" Then Exit Sub
    If MsgBox("Confirmez-vous la suppression de la fiche " & TextBox1 & " ?", vbYesNo, "La suppression a été prise en compte.") = vbYes Then
        With Sheets("Adhérent")
            L = .Range("A" & .Rows.Count).End(xlUp).Row.Find(TextBox1, lookat:=xlWhole).Row
            .Rows(L & ":" & L).Delete Shift:=xlUp
        End With
    Else
        Exit Sub
    End If
    MsgBox "La fiche " & TextBox1 & " a été supprimée."
    Unload Me
    UserForm1.Show
End Sub

'Pour le bouton Quitter
Private Sub CommandButton3_Click()
    Unload Me
End Sub

'pour le bouton Modifier
Private Sub CommandButton4_Click()
    
    If TextBox1 = "" Then Exit Sub
    If MsgBox("Confirmez-vous la modification de la fiche " & TextBox1 & " ?", vbYesNo, "La modification a été prise en compte.") = vbYes Then
        L = .Range("A" & .Rows.Count).End(xlUp).Row.Find(ComboBox1, lookat:=xlWhole).Row
        flag = 1
      Select Case x
        Case 1, 2, 4 To 6, 8 To 12, 15 To 28, 42 To 46, 50
        iT = iT + 1
            .Cells(L, x) = Controls("TextBox" & iT).Text
        Case 3, 7, 39, 40, 49
        iC = iC + 1
            .Cells(L, x) = Controls("ComboBox" & iC).Text
        Case 13, 14, 29 To 38, 47, 48
        iCB = iCB + 1
            .Cells(L, x) = IIf(Me.Controls("CheckBox" & iCB).Value = True, "X", "")
        End Select
        Next x
        flag = 0
    End If
    MsgBox "La fiche " & TextBox1 & " a été modifiée."
    Unload Me
    UserForm1.Show
End Sub
'Pour rechercher
Private Sub ComboBox1_Change()

    If flag = 1 Then Exit Sub
    If ComboBox1 = "" Then Exit Sub
    If Not ComboBox1.Value = "" Then
        no_L = ComboBox1.ListIndex + 3
        For n = 1 To 50
            Controls("TextBox" & n) = .Cells(no_L, n).Value
        Next n
    Else
        MsgBox "Vous devez choisir un nom.", 16
        Exit Sub
    End If
End Sub

Private Sub UserForm1_initialize()

'Récupération des Données

    ComboBox1.List = Sheets("Adhérent").Range("A3:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    ComboBox2.RowSource = "liste!A2:A3"
    ComboBox3.RowSource = "liste!b2:b14"
    ComboBox4.RowSource = "liste!c2:c4"
    ComboBox5.RowSource = "liste!d2:d3"
    ComboBox6.RowSource = "liste!e2:e10"
End Sub

Private Sub UserForm_Click()

End Sub
 

Pièces jointes

  • Inscription.xlsm
    32.2 KB · Affichages: 5

ALS35

XLDnaute Impliqué
Bonsoir,

1. Parce que ta première Combobox est la ComboBox2 (et non pas 1), tel que ton code est fait il faut initialiser iC à 1 avant la boucle For. En plus pour les CheckBox ton instruction If est totalement fausse, tu as écrit comme une formule Excel et non pas vba
2. Je ferais ça avec une boucle sur les noms et en testant le prénom si le nom correspond
3. Pas regardé
4. Pas regardé
5. Pas compris

C'est toi qui a écrit le code ou c'est un code récupéré que tu essaies d'adapter ?

Cordialement
 

Richard 58

XLDnaute Nouveau
Bonsoir,

1. Parce que ta première Combobox est la ComboBox2 (et non pas 1), tel que ton code est fait il faut initialiser iC à 1 avant la boucle For. En plus pour les CheckBox ton instruction If est totalement fausse, tu as écrit comme une formule Excel et non pas vba
2. Je ferais ça avec une boucle sur les noms et en testant le prénom si le nom correspond
3. Pas regardé
4. Pas regardé
5. Pas compris

C'est toi qui a écrit le code ou c'est un code récupéré que tu essaies d'adapter ?

Cordialement
Merci d'avoir regardé.
Pour répondre à ta dernière question, vu que je ne connais pas grand chose, j'essaie d'adapter un code existant. Parfois cela marche d'autre fois non.

Je suis donc preneur des corrections ou des réécritures de codes.
 

ALS35

XLDnaute Impliqué
Merci d'avoir regardé.
Pour répondre à ta dernière question, vu que je ne connais pas grand chose, j'essaie d'adapter un code existant. Parfois cela marche d'autre fois non.

Je suis donc preneur des corrections ou des réécritures de codes.
Bonjour,

Je vais regarder plus en détail dès que j'aurais un peu de temps, mais il y a pas mal d'erreurs !

Cordialement
 

ALS35

XLDnaute Impliqué
Bonjour,

Ci-joint une version modifié de ton fichier qui ne doit pas être loin de ce que tu souhaites.
Il y avait plusieurs problèmes, entre autres le nom erroné de la procédure UserForm_initialize, et des erreurs dans l'initialisation des ComboBox ainsi que plein de petites choses à droite ou à gauche.
J'ai fait pas mal de modifs, mais j'ai gardé la structure générale de ton code. La Combobox de recherche inclut maintenant le nom et le prénom (dans la liste).
Je n'ai probablement pas tout testé. Regarde si tout est ok et si cela te convient.
Reviens pour explications ou modifications.

Cordialement
 

Pièces jointes

  • XLD Inscription modifié2.xlsm
    48.5 KB · Affichages: 11

Richard 58

XLDnaute Nouveau
Bonjour,

Ci-joint une version modifié de ton fichier qui ne doit pas être loin de ce que tu souhaites.
Il y avait plusieurs problèmes, entre autres le nom erroné de la procédure UserForm_initialize, et des erreurs dans l'initialisation des ComboBox ainsi que plein de petites choses à droite ou à gauche.
J'ai fait pas mal de modifs, mais j'ai gardé la structure générale de ton code. La Combobox de recherche inclut maintenant le nom et le prénom (dans la liste).
Je n'ai probablement pas tout testé. Regarde si tout est ok et si cela te convient.
Reviens pour explications ou modifications.

Cordialement
Bonjour,
Je viens de tester avec 2 inscriptions cela à l'air bien.
Merci
 

Discussions similaires

Réponses
4
Affichages
450
Réponses
2
Affichages
329

Statistiques des forums

Discussions
315 093
Messages
2 116 139
Membres
112 669
dernier inscrit
Guigui2502