formulaire de saisie, combobox fonctionne pas

jardibot · 28 Février 2015

Bonjour,

Dans mon formulaire de saisie (il y a 33 textbox, des labels, un combobox, deux frames avec des optionbutton). Je n'ai pas renommé les textbox ni combobox). J'ai un bouton 'Modifier', et "Ajouter contact" et Quitter.

Mon 'combobox1' (le seul que j'ai), ne fonctionne pas.

Pourriez-vous m'aidez à trouver l'erreur?

De plus, lors de la saisie des optionbutton, il y a une erreur aussi… que je ne trouve pas. Merci de m'aidez

Code:

Option Explicit
Dim Ws As Worksheet
Private Sub UserForm1_Initialize()
Dim J As Long
Dim I As Integer

  Set Ws = Sheets("FICHE_INSCRIPTION") '
  With Me.ComboBox1
    For J = 2 To Ws.Range("C" & Rows.Count).End(xlUp).Row
      .AddItem Ws.Range("C" & J)
    Next J
  End With
  For I = 1 To 33
    Me.Controls("TextBox" & I).Visible = True 'affiche les données dans les textbox
Next I
End Sub
Private Sub ComboBox1_Change()
Dim Ligne As Long
Dim I As Integer
   If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  Ligne = Me.ComboBox1.ListIndex + 2
  For I = 1 To 33
    Me.Controls("TextBox" & I) = Ws.Cells(Ligne, I + 2)
  Next I
 End Sub
Private Sub BT_MODIFIER_Click()
Dim Ligne As Long
Dim I As Integer
If MsgBox("Etes-vous certain de vouloir modifier ce produit ?", vbYesNo, "Demande de confirmation") = vbYes Then

  If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  Ligne = Me.ComboBox1.ListIndex + 2
  For I = 1 To 33
    If Me.Controls("TextBox" & I).Visible = True Then
      Ws.Cells(Ligne, I + 2) = Me.Controls("TextBox" & I)
    End If
  Next I
    End If
End Sub
Private Sub BT_QUITTER_Click()
Unload UserForm1
End Sub

Private Sub BT_AJOUTER_CONTACT_Click()
Dim L As Integer, lieu_inscription As String, civilite As String

If MsgBox("Etes-vous certain de vouloir INSERER ce nouveau contact ?", vbYesNo, "Demande de confirmation") = vbYes Then
L = Sheets("FICHE_INSCRIPTION").Range("a65536").End(xlUp).Row + 1 'Permet de se positionner sur la dernière ligne de tableau NON VIDE

'Choix lieu et civilite
For Each bouton_lieu_inscription In Frame_lieu_inscription.Controls
    If bouton_lieu_inscription.Value Then
      lieu_inscription = bouton_lieu_inscription.Caption
    End If
Next
For Each bouton_civilite In Frame_civilite.Controls
    If bouton_civilite.Value Then
      civilite = bouton_civilite.Caption
    End If
Next


Range("A" & L).Value = lieu_inscription
Range("B" & L).Value = civilite
Range("C" & L).Value = ComboBox1
Range("D" & L).Value = TextBox1
Range("E" & L).Value = TextBox2
Range("F" & L).Value = TextBox3
Range("G" & L).Value = TextBox4
Range("H" & L).Value = TextBox5
Range("I" & L).Value = TextBox6
Range("J" & L).Value = TextBox7
Range("K" & L).Value = TextBox8
Range("L" & L).Value = TextBox9
Range("M" & L).Value = TextBox10
Range("N" & L).Value = TextBox11
Range("O" & L).Value = TextBox12
Range("P" & L).Value = TextBox13
Range("Q" & L).Value = TextBox14
Range("R" & L).Value = TextBox15
Range("S" & L).Value = TextBox16
Range("T" & L).Value = TextBox17
Range("U" & L).Value = TextBox18
Range("V" & L).Value = TextBox19
Range("W" & L).Value = TextBox20
Range("X" & L).Value = TextBox21
Range("Y" & L).Value = TextBox22
Range("Z" & L).Value = TextBox23
Range("AA" & L).Value = TextBox24
Range("AB" & L).Value = TextBox25
Range("AC" & L).Value = TextBox26
Range("AD" & L).Value = TextBox27
Range("AF" & L).Value = TextBox28
'Range("AE" & L).Value = TextBox_Description_Traitement
'Range("AG" & L).Value = TextBox_Vaccinations
Range("AH" & L).Value = TextBox29
'Range("AI" & L).Value = TextBox_Allergies
Range("AJ" & L).Value = TextBox30
'Range("AK" & L).Value = TextBox_Regime_Alimentaire
Range("AL" & L).Value = TextBox31
Range("AM" & L).Value = TextBox32
'Range("AN" & L).Value = TextBox_Droit_Image
'Range("AO" & L).Value = TextBox_Droit_Depart
Range("AP" & L).Value = TextBox33
End If

MsgBox ("Produit inséré dans fichier sélectionné") 'Vous informe que le présent contact est insérer dans votre tableau Excel.

Unload Me 'Ferme le formulaire
UserForm1.Show 'Ouvre le formulaire

'Après insertion, on remet les valeurs initiales
OptionButton1.Value = True

End Sub

jardibot · 2 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Laetitia

Je viens de trouver, mon ordinateur est un Apple et ne reconnait pas Mondico, sur un ordinateur windows ça fonctionne..
Merci d'avoir regardé, je vais maintenant essayé d'adapter le reste de mon code à mon fichier contact (sous windows su coup)

jardibot · 2 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Laetitia je reviens vers vous!

Maintenant que ça fonctionne, avec des variables bien définies,
je souhaiterais que les données s'affichent non pas dans une mais plusieurs textbox. En faite j'en ai 33.

Comment puis-je modifier la partie en gras de ce code? pour que les 33 textbox affichent leurs données? en utilisant For I = 1 To 33

Code:

Private Sub Combobox_PRENOM_click()
Dim c As Range
  For Each c In f.Range("B2:B" & f.[B65000].End(xlUp).Row) ' on explore la colonne de niveau 1
    If c = Me.ComboBox_NOM_FAMILLE And c.Offset(, 1) = Me.ComboBox_PRENOM [B]Then Me.TextBox1 = c.Offset(, +2)[/B] ' si famille alors on ajoute l'_l_ment de la sous-famille au dictionnaire
  Next c
End Sub

Voilà ce que je pensais mais ça marche pas:

Private Sub Combobox_PRENOM_click()
Dim c As Range, I As Integer

For Each c In f.Range("A2:A" & f.[B65000].End(xlUp).Row) ' on explore la colonne de niveau 1
If c = Me.ComboBox_NOM_FAMILLE And c.Offset(, 1) = Me.ComboBox_PRENOM Then
For I = 1 To 33
Me.Controls("TextBox" & I) = f.Cells(c.Offset(, I + 2) ' si famille alors on ajoute l'élément de la sous-famille au dictionnaire
Next I
Next c
End Sub

merciiii

Paf · 2 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

re

concernant Dico et Mac, toujours chez J. Boisgontier Objet dictionary une similation de Dictionary qui fonctionne sur Mac et Windows

A+

Paf · 2 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Re

pour l'affichage des textbox, un exemple fonctionnant sur le fichier joint( 3 textbox)

Code:

Private Sub Combobox_PRENOM_click()
 Dim c As Range, I As Integer
 For Each c In f.Range("A2:A" & f.[B65000].End(xlUp).Row) ' on explore la colonne de niveau 1
    If c = Me.ComboBox_NOM_FAMILLE And c.Offset(, 1) = Me.ComboBox_PRENOM Then
        For I = 1 To 3
            Me.Controls("TextBox" & I) = c.Offset(, I + 1) '
        Next I
    End If
 Next c
End Sub

Bonne suite

jardibot · 2 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Merci Paf pour l'info sur les macs!!

Je suis encore trop débutant pour bien saisir ce qu'il faudrait changer à :
Set MonDico = CreateObject("Scripting.Dictionary") pour que mac le comprenne..

Je comprend qu'il faut un dictionnaireMac , je vais lire votre lien à nouveau.

Merci Laetitia

Je suis très satisfait que ça marche

Une petite question supplémentaire

Après une première recherche via combobox 1 et 2 toutes les données sont dans les textbox. C'est parfait.

Lorsque à ce moment je click sur Combobox_NOM_FAMILLE, pour changer de famille, les textbox ne s'effacent pas, car je ne sais pas écrire le code pour que toutes les textbox s'effacent d'un coup.

Code:

Private Sub Combobox_NOM_FAMILLE_click()
  Dim c As Range
  Me.ComboBox_PRENOM.Clear

[COLOR="#006400"][B]'Comment faire pour appliquer la fonction clear  pour que les 3 ou 33 textbox s'effacent s'en les renommer toutes :)

Et si jamais j'avais des Frames avec des optionbutton aussi :)[/B][/COLOR]

  Set MonDico = CreateObject("Scripting.Dictionary")
  For Each c In f.Range("A2:A" & f.[B65000].End(xlUp).Row) ' on explore la colonne de niveau 1
     If c = Me.ComboBox_NOM_FAMILLE Then MonDico(c.Offset(, 1).Value) = "" ' si famille alors on ajoute l'_l_ment de la sous-famille au dictionnaire
  Next c
  Me.ComboBox_PRENOM.List = MonDico.keys
End Sub

BOISGONTIER · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Bonsoir,

Formulaire cascade 2 niveaux sans doublons triés compatible Mac.

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormCascade2nivMac.xls

JB

jardibot · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Bonjour à vous Mr Boisgontier

C'est une joie de pouvoir lire votre message et de pouvoir à nouveau utiliser mon Mac. Je vous remercie.

Dans votre exemple: Formulaire cascade 2 niveaux sans doublons triés compatible Mac.

Je voudrais vous demander, quelles seraient les valeurs à changer si la colonne A(correspondant à Code) était mise à la place de la colonne C . On aurait ainsi colonne A = Familles, colonne B= sous-familles, colonne C= Code

Merci vraiment

BOISGONTIER · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Bonjour,

Voir PJ

Code:

Private Sub UserForm_Initialize()
  Set f = Sheets("base")
  Dim b()
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Call Tri(a, LBound(a), UBound(a))
  ReDim b(1 To UBound(a))
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j) = a(i)
    Do While a(i) = b(j)
       i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
  ReDim Preserve b(1 To j)
  Me.Famille.List = b
End Sub

Private Sub Famille_click()
  Me.SousFamille.Clear
  a = f.Range("A2:B" & f.[B65000].End(xlUp).Row).Value
  Dim b(): ReDim b(1 To UBound(a))
  j = 0
  For i = 1 To UBound(a)
     If a(i, 1) = Me.Famille Then j = j + 1: b(j) = a(i, 2)
  Next i
  ReDim Preserve b(1 To j)
  Call Tri(b, LBound(b), UBound(b))
  Me.SousFamille.List = b
End Sub

Private Sub SousFamille_click()
  For Each c In f.Range("A2:A" & f.[B65000].End(xlUp).Row)
     If c = Me.Famille And c.Offset(, 1) = Me.SousFamille Then Me.Code = c.Offset(, 2)
  Next c
End Sub

JB

jardibot · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Mr Boisgontier

J'ai pu voir où sont les différences. C'est génial !!! Et je garde mon Mac MERCI !!!

Si je peux vous demander une petite chose, j'ai rajouté un bouton "modifier" qui permet après une recherche via la famille et la sous-famille de changer une donnée d'une textbox ou de plusieurs. (dans votre exemple se serait si on veut modifier la colonne CODE après une recherche)

Dans mon adaptation, j'ai 3 textbox, mais avec les modifications apportées, ça ne fonctionne pas. Pouvez-vous regardez? merci

Code:

Private Sub BT_MODIFIER_Click()
Dim Ligne As Long, K As Integer
If MsgBox("Etes-vous certain de vouloir modifier ce contact ?", vbYesNo, "Demande de confirmation") = vbYes Then

[B][COLOR="#FF0000"] 
'If Me.Combobox_NOM_FAMILLE.List = -1 Then Exit Sub
 'Ligne = Me.Combobox_NOM_FAMILLE.List + 2
[/COLOR][/B]

  For K = 1 To 3
    If Me.Controls("TextBox" & K).Visible = True Then
      f.Cells(Ligne, K + 2) = Me.Controls("TextBox" & K)
    End If
 Next K
    End If
    Unload Me 'Ferme le formulaire
UserForm1.Show 'Ouvre le formulaire
End Sub

BOISGONTIER · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Voir PJ

JB

jardibot · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

C'est vraiment trop bien.

Juste pour affiner, est-il possible après une recherche via combobox NOM_FAMILLE et combobox_PRENOM que l'on est la possibilité de modifier en plus le "Prenom" dans la combobox_PRENOM ? et d'empêcher l'utilisateur de modifier la combobox_Nom_famille

Ex: j'ai fait une recherche. Les données s'affichent dans les textbox, je modifie le ou les textbox (ça marche! ), et je voudrais avoir la possibilité de modifie le prénom, de cliquer sur modifier pour enregistrer les modifications et
d'empêcher l'utilisateur de pouvoir changer le Nom de famille de la comboboxNOM_FAMILLE. (je pars du principe que le nom de famille est toujours correct)

Ainsi il serait possible de tout faire.

Encore merci à vous

BOISGONTIER · 3 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Code:

Private Sub Combobox_PRENOM_click()
Dim K As Integer
 For i = 2 To f.[B65000].End(xlUp).Row
     If f.Cells(i, "a") = Me.ComboBox_NOM_FAMILLE And f.Cells(i, "b") = Me.ComboBox_PRENOM Then
      For K = 1 To 3
        Me.Controls("TextBox" & K) = f.Cells(i, K + 2)
      Next K
      ligne = i
    End If
  Next i
  Me.ComboBox_NOM_FAMILLE.Locked = True
End Sub

Private Sub BT_MODIFIER_Click()
  If MsgBox("Etes-vous certain de vouloir modifier ce contact ?", vbYesNo, "Demande de confirmation") = vbYes And ligne > 1 Then
    For K = 1 To 3
      tmp = Me.Controls("TextBox" & K)
      If IsNumeric(tmp) Then tmp = Val(tmp)
      f.Cells(ligne, K + 2) = tmp
    Next K
    f.Cells(ligne, "b") = Me.ComboBox_PRENOM
    Unload Me
  End If
End Sub

Dans la PJ, j'ai ajouté une fonction sansDoublonsTrié(tableau) qui fonctionne sans dictionnaire et retourne un tableau sans doublons trié. Cette fonction est évidemment réutilisable.

Code:

Private Sub UserForm_Initialize()
  Set f = Sheets("base")
  Dim b(), a()
  a = Application.Transpose(f.Range("A2:A" & f.[A65000].End(xlUp).Row).Value)
  Me.ComboBox_NOM_FAMILLE.List = SansDoublonsTrié(a())
End Sub

Code:

Function SansDoublonsTrié(a())
  Call Tri(a, LBound(a), UBound(a))
  Dim b(): ReDim b(1 To UBound(a))
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j) = a(i)
    Do While a(i) = b(j)
       i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
  ReDim Preserve b(1 To j)
  SansDoublonsTrié = Application.Transpose(b)
End Function

JB

jardibot · 4 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Mr Boisgontier

C'est vraiment super. Merci pour vos réponses. Je consulte votre site en même temps.

Je profite pour vous demandez, toujours dans le formulaire cascade 2 niveaux sans doublons triés compatible Mac,

J'ai ajouté un frame_Civilite (caption Garçon et caption Fille), comment peut-on faire apparaître ces données du Frame à la suite de la recherche via combobox_Nom_FAMILLE et combobox_PRENOM, ainsi que pour permettre de les modifier?

J'ai fait un essai sans trouver comment le faire fonctionner.. Merci

Code:

Private Sub Combobox_PRENOM_click()
Dim K As Integer
 For i = 2 To f.[B65000].End(xlUp).Row
     If f.Cells(i, "a") = Me.ComboBox_NOM_FAMILLE And f.Cells(i, "b") = Me.ComboBox_PRENOM Then
      
   [COLOR="#FF0000"]   
     ' For Each bouton_civilite In Frame_Civilite.Controls
    'Me.Controls("Civilite") = f.Cells(i, 2)
'End If
'Next[/COLOR]
 
      For K = 1 To 3
        Me.Controls("TextBox" & K) = f.Cells(i, K + 3)
      Next K
      ligne = i
    End If
  Next i
  Me.ComboBox_NOM_FAMILLE.Locked = True
End Sub

Private Sub BT_MODIFIER_Click()
  If MsgBox("Etes-vous certain de vouloir modifier ce contact ?", vbYesNo, "Demande de confirmation") = vbYes And ligne > 1 Then
    
   [COLOR="#FF0000"]  ' For Each bouton_civilite In Frame_Civilite.Controls
    'Me.Controls("Civilite") = f.Cells(i, 2)
'End If
'Next
    [/COLOR]
    For K = 1 To 3
      tmp = Me.Controls("TextBox" & K)
      If IsNumeric(tmp) Then tmp = Val(tmp)
      f.Cells(ligne, K + 3) = tmp
    Next K
    f.Cells(ligne, "b") = Me.ComboBox_PRENOM
    Unload Me
  End If
End Sub

Une autre question juste pour un renseignement, est-il possible de faire une recherche à partir du Frame_Civilite? Pour par exemple avoir la liste de tout les garçons dans une msgbox qui donnerait la liste des garçons en reprenant les champs Famille, Prénom, Commune, Age. Merci

BOISGONTIER · 4 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Bonjour,

CF PJ

Code:

Private Sub Combobox_PRENOM_click()
Dim K As Integer
 For i = 2 To f.[B65000].End(xlUp).Row
  If f.Cells(i, "a") = Me.ComboBox_NOM_FAMILLE And f.Cells(i, "b") = Me.ComboBox_PRENOM Then
    ligne = i
    For Each c In Me.Frame_Civilite.Controls
     If f.Cells(ligne, "c") = c.Caption Then c.Value = True
    Next c
    For K = 1 To 3
        Me.Controls("TextBox" & K) = f.Cells(i, K + 3)
      Next K
    End If
  Next i
  Me.ComboBox_NOM_FAMILLE.Locked = True
End Sub


Private Sub BT_MODIFIER_Click()
  If MsgBox("Etes-vous certain de vouloir modifier ce contact ?", vbYesNo, "Demande de confirmation") = vbYes And ligne > 1 Then
   temp = ""
   For Each c In Me.Frame_Civilite.Controls
     If c.Value = True Then temp = c.Caption
   Next c
   f.Cells(ligne, "c") = temp
   For K = 1 To 3
      tmp = Me.Controls("TextBox" & K)
      If IsNumeric(tmp) Then tmp = Val(tmp)
      f.Cells(ligne, K + 3) = tmp
    Next K
    f.Cells(ligne, "b") = Me.ComboBox_PRENOM
    Unload Me
  End If
End Sub

http://boisgontierjacques.free.fr/fichiers/Formulaire/FormCascade2nivPcMac.xls

JB

jardibot · 5 Mars 2015

Re : formulaire de saisie, combobox fonctionne pas

Mr Boisgontier

Je voulais vous solliciter à nouveau. Tout ce que j'ai pu apprendre des cascades sans doublons triés pour mac, je l'ai adapté à mon formulaire de saisie. J'en suis très satisfait. Merci à vous et toutes les autres personnes qui m'aident.

Cela dit, j'ai un problème que je comprend mais que je ne peux résoudre.

J'ai 38 textbox et 8 Frame(optionButton) qui sont dans le tableur excel de la colonne C à AV. Les informations collectées des Frame(Optionbutton) sont au milieu de ces colonnes C à AV. (Elles ne sont pas les unes à côté des autres, pour des raisons de compréhension).

Lorsque j'ajoute un contact, tout se passe très bien textbox et tout les optionbutton OK

Lorsque je modifie un contact, les données modifiées dans les textbox se décalent dans mon tableur excel. Car j'utilise la formule For i = 1 To 38 et que les 38 textbox ne sont pas les unes à côtés des autres dans mon tableur excel.(les colonnes pour collecter les informations des optionButton sont entre des colonnes pour collecter les informations des texbox, et je ne souhaite pas les changer de place)

Auriez-vous une solution?
Peut-etre faut-il que chaque textbox soit reliés à une colonne nommée dans mon tableur excel? comme ça l'utilisateur peut intervertir les colonnes sans que le code change et ça résoudrait aussi le problème précédent?

De plus, à partir d'un bouton sur un userform comment peut-on faire pour rendre invisible un bouton BT_MODIFIER" situé sur un autre userform?
Dans mon formulaire, dans l'userform2 quand je clique sur le Bouton "Ajouter Contact", je souhaite que l'userform1 apparaissent mais en rendant invisible le bouton "MODIFIER". (C'est pour que l'utilisateur ne mélange pas tout).

Je vous remercie.

formulaire de saisie, combobox fonctionne pas

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Pièces jointes

Discussions similaires