VBA : Alimenter une cellule avec un "1" apres selection d'un item dans combobox

Samy_y

XLDnaute Nouveau
Bonjour a toutes et a tous,

Merci par avance des réponses que vous allez m'apporter ;)

Je vous expose mon soucis :
Je suis en train de créer un formulaire pour alimenter une base de donnée, jusque la rien d'extraordinaire, l'utilisateur doit référencer les champs classiques puis arrive une checkbox qui indique si le consommateur que j'ai entré a participé a une étude.

Dans ce cas une listebox apparaît et propose différents numéro d'études.

Si l'étude ne figure pas dans la liste, un bouton est la pour en ajouter.

Mon problème est le suivant :
Je souhaite que, lorsqu'on sélectionne une étude, un "1" soit incrémenté dans la cellule qui correspond a la ligne du consommateur que je viens d'ajouter.


Pouvez vous me venir en aide ?

PS : Je m’intéresse à VBA depuis une dizaine de jour, je ne demande qu'a apprendre :)
 

Pièces jointes

  • Base_S.zip
    255.3 KB · Affichages: 54

Papou-net

XLDnaute Barbatruc
Re : VBA : Alimenter une cellule avec un "1" apres selection d'un item dans combobox

Bonsoir Samy_y, et bienvenue,

Je te propose de modifier ton code comme ci-dessous:

Code:
'Pour le bouton Nouveau contact
Private Sub CommandButton1_Click()

 Worksheets("Base").Unprotect Password:="*1SAM1*"
    If TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Or TextBox5 = "" Then
        MsgBox "Les champs avec asterix sont obligatoires."
         TextBox2.SetFocus
Exit Sub

    Else
'condition mobile
        If Len(TextBox5.text) < 14 Then
MsgBox ("Vous devez saisir un numéro de téléphone portable à 10 chiffres ")
TextBox5.SetFocus
Exit Sub
End If
If IsNumeric(TextBox5.text) = False Then
MsgBox ("Vous ne devez saisir que des chiffres")
TextBox5.SetFocus
Exit Sub
End If
'condition fixe
         If Len(TextBox6.text) < 14 & Len(TextBox6.text) > 1 Then
MsgBox ("Vous devez saisir un numéro de téléphone portable à 10 chiffres ")
TextBox6.SetFocus
Exit Sub
End If
If IsNumeric(TextBox6.text) = False Then
MsgBox ("Vous ne devez saisir que des chiffres")
TextBox6.SetFocus
Exit Sub
'condition date de naissance
End If
   If Len(TextBox4.text) < 10 Then
MsgBox ("Vous devez saisir une date de naissance sous la forme : JJ/MM/AAAA")
TextBox4.SetFocus
Exit Sub
End If

        Dim L As Integer
If MsgBox("Confirmez-vous l'ajout de ce nouveau contact ?", vbYesNo, "Demande de confirmation d’ajout") = vbYes Then
  With Sheet1 '------------------------------------------------------------------
    L = .Range("b65536").End(xlUp).Row + 1 'Pour placer le nouvelenregistrement à la première ligne de tableau non vide
    .Range("F" & L).Value = ComboBox2 'sexe
    .Range("C" & L).Value = TextBox1 'Date inscription
    .Range("D" & L).Value = TextBox2  'Nom
    .Range("E" & L).Value = TextBox3  'Prénom
    .Range("G" & L).Value = TextBox4 'Date naissance
    .Range("J" & L).Value = TextBox5 'Mobile
    .Range("I" & L).Value = TextBox6 'telephone
    .Range("K" & L).Value = TextBox7 'Mobile2
    .Range("L" & L).Value = TextBox8 'Mail
    .Range("A" & L).Value = Application.Max(Sheets("Base").Range("a2:a70000")) + 1  'ID SAM affichage
    .Range("B" & L).Value = ComboBox3 'sexe
    TextBox9.Value = Application.Max(.Range("a2:a70000")) + 1  'ID SAM numéro

    'Incrémentation étude
    If CheckBox1 Then
      Dim Col As Byte
      On Error Resume Next
      Col = .Rows(1).Find(ComboBox4.Value, LookIn:=xlValues).Column
      .Cells(L, Col) = .Cells(L, Col) + 1
    End If
    
  End With '----------------------------------------------------------------------
  
  Else: Exit Sub

End If
End If

Unload Me
UserForm1.Show
End Sub

La partie nouvelle (ou modifiée) est entre tirets.

Puisque tu es désireux de progresser en VBA, je me suis permis d'introduire une instruction With...End With qui t'évite d'avoir à répéter le nom de feuille à chaque fois: il suffit de faire précéder les adresses de cellules par un point, ce qui les rattache à la feuille citée.

Tu remarqueras par ailleurs que j'ai repris l'indentation du code pour la partie modifiée afin d'améliorer la lisibilité et la compréhension du code (c'est une bonne habitude à prendre dès le début).

Cordialement.
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA