Extraction de listbox.
Résolu/Fermé
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
-
30 août 2017 à 19:34
TitiPointCom67 Messages postés 38 Date d'inscription vendredi 25 août 2017 Statut Membre Dernière intervention 12 septembre 2017 - 7 sept. 2017 à 12:34
TitiPointCom67 Messages postés 38 Date d'inscription vendredi 25 août 2017 Statut Membre Dernière intervention 12 septembre 2017 - 7 sept. 2017 à 12:34
Bonjour, je suis un peu moins que débutant en VBA et j'ai besoin de vos services.
Je suis bénévole dans une association et je dois gérer les adhérents. J'ai un tableau de 21 colonnes avec lesquelles une listbox1 me fait une liste en fonction du choix d'un critère. Pour l'instant, tout cela fonctionne
J'ai également une userform "ADHERENTS" dont les champs sont également alimentés par la feuille de 21 colonnes pour les mises à jour ou autre.
Je voudrais que 2 choses se passent lorsque je sélectionne une ligne dans la listbox (pas forcément simultanément).
1- les colones étant trop nombreuses pour être imprimées sur une feuille, ma sélection soit imprimée sous forme de 2 colonnes, l'une correspondant aux entêtes de colonnes et l'autre à la sélection dans la listbox.
2-Que l'userform "ADHERENTS" s'ouvre avec les champs complétés par la sélection de la listbox1.
J'en demande peut être beaucoup, en tous cas un énorme merci si vous me rendez ce service.
Je suis bénévole dans une association et je dois gérer les adhérents. J'ai un tableau de 21 colonnes avec lesquelles une listbox1 me fait une liste en fonction du choix d'un critère. Pour l'instant, tout cela fonctionne
J'ai également une userform "ADHERENTS" dont les champs sont également alimentés par la feuille de 21 colonnes pour les mises à jour ou autre.
Je voudrais que 2 choses se passent lorsque je sélectionne une ligne dans la listbox (pas forcément simultanément).
1- les colones étant trop nombreuses pour être imprimées sur une feuille, ma sélection soit imprimée sous forme de 2 colonnes, l'une correspondant aux entêtes de colonnes et l'autre à la sélection dans la listbox.
2-Que l'userform "ADHERENTS" s'ouvre avec les champs complétés par la sélection de la listbox1.
J'en demande peut être beaucoup, en tous cas un énorme merci si vous me rendez ce service.
A voir également:
- Extraction de listbox.
- Extraction video youtube - Guide
- Extraction impossible android - Forum Samsung
- Logiciel extraction cd - Télécharger - Conversion & Extraction
- Extraction audio d'une video - Guide
- Windows ne peut pas effectuer l'extraction ✓ - Forum Compression
17 réponses
fabien25000
Messages postés
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
30 août 2017 à 19:58
30 août 2017 à 19:58
Bonsoir,
un fichier exemple pour illustrer peut aider à mieux comprendre le besoin (surtout pour le premier point)
pour afficher l'userform"Adherants" remplis, une boucle devrait faire l'affaire ;)
un fichier exemple pour illustrer peut aider à mieux comprendre le besoin (surtout pour le premier point)
pour afficher l'userform"Adherants" remplis, une boucle devrait faire l'affaire ;)
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
30 août 2017 à 20:15
30 août 2017 à 20:15
Qu'entendez-vous par fichier exemple ?
Dois-je joindre le code déjà existant ?
Dois-je joindre le code déjà existant ?
fabien25000
Messages postés
673
Date d'inscription
mercredi 5 octobre 2016
Statut
Membre
Dernière intervention
28 juillet 2022
59
30 août 2017 à 20:26
30 août 2017 à 20:26
surtout un fichier qui ne dévoile rien qui puisse etre confidentiel oui
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
30 août 2017 à 20:39
30 août 2017 à 20:39
Ceci est le code de l'userform contenant la Listbox
Private Sub UserForm_Initialize() Set f = Sheets("INSCRIPTIONS") Set Rng = f.Range("A2:U" & f.[a65000].End(xlUp).Row) bd = Rng.Value ' BD dans un Array pour rapidié Ncol = Rng.Columns.Count titre = Application.Index(Rng.Offset(-1).Value, 1) ' Titres de la BD Me.ComboBox1.List = titre bd = Rng.Value Me.ListBox1.List = bd '--- titres ListBox x = 10 y = Me.ListBox1.Top - 12 For i = 1 To Ncol Set Lab = Me.Controls.Add("Forms.Label.1") Lab.Caption = f.Cells(1, i) Lab.Top = y Lab.Left = x + 5 x = x + f.Columns(i).Width * 0.8 temp = temp & f.Columns(i).Width * 0.8 & ";" Next Me.ListBox1.ColumnWidths = temp Me.ListBox1.ColumnCount = Ncol Me.Label4.Caption = Me.ListBox1.ListCount & " Ligne(s)" End Sub Private Sub ComboBox1_Change() ' choix de la colonne de recherche If IsNumeric(Me.ComboBox1) Then tmp = Val(Me.ComboBox1) Else tmp = Me.ComboBox1 colClé = Application.Match(tmp, titre, 0) Me.Label2.Caption = Me.ComboBox1 Set d1 = CreateObject("Scripting.Dictionary") For i = LBound(bd) To UBound(bd) ' liste des choix de la colonne choisie sans doublons d1(bd(i, colClé)) = "" Next i choix = d1.keys: Tri choix, LBound(choix), UBound(choix) ComboBox2.List = choix End Sub Private Sub ComboBox2_click() ' alimentation ListBox If IsNumeric(Me.ComboBox2) Then clé2 = Val(Me.ComboBox2) Else clé2 = Me.ComboBox2 Me.ListBox1.Column = FiltreMultiColTransp(bd, clé2, colClé) Me.Label4.Caption = Me.ListBox1.ListCount & " Ligne(s)" End Sub Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ComboBox2.List = choix Me.ComboBox2.DropDown End Sub Function FiltreMultiColTransp(Tbl, clé, colClé) Ncol = UBound(Tbl, 2) Dim b(): n = 0 For i = LBound(Tbl) To UBound(Tbl) If clé = Tbl(i, colClé) Then n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n) For k = 1 To Ncol: b(k, n) = Tbl(i, k): Next k End If Next i If n > 0 Then FiltreMultiColTransp = b End Function Sub Tri(a, gauc, droi) ' Quick sort ref = a((gauc + droi) \ 2) g = gauc: d = droi Do Do While a(g) < ref: g = g + 1: Loop Do While ref < a(d): d = d - 1: Loop If g <= d Then temp = a(g): a(g) = a(d): a(d) = temp g = g + 1: d = d - 1 End If Loop While g <= d If g < droi Then Tri a, g, droi If gauc < d Then Tri a, gauc, d Me.Label4.Caption = Me.ListBox1.ListCount & " Ligne(s)" End Sub <gras>Ceci est le code de l'userform contenant les champs</gras> <code basic> '********************************************************************* ' Bouton Liste NOMS par N° ADHERENTS '********************************************************************** Private Sub CommandButton1_Click() UserForm3.Hide UserForm5.Show 1 End Sub '****************************************************************** 'Bouton Listes NOMS par COMMUNES '****************************************************************** Private Sub CommandButton2_Click() UserForm3.Hide UserForm6.Show 1 End Sub Private Sub INSCRIPTIONS_Click() Sheets("INSCRIPTIONS").Activate 'Ouvre la feuille ActiveSheet.Shapes("Image 4").Visible = False 'Rend invisible le logo ActiveSheet.Shapes("Rectangle 3").Visible = False 'Rend invisible le rectangle blanc pour afficher les données Range("A1").Select 'Se place sur la cellule A1 Unload Me End Sub '****************************************************************** 'Bouton Listes codes '****************************************************************** Private Sub ListeNoms_Click() UserForm3.Hide UserForm9.Show 1 End Sub '********************************************************************* ' Bouton Suivant '********************************************************************** Private Sub SUIVANT_Click() If ActiveCell.Offset(1, 0) = "" Then 'Si le curseur se retrouve sur la dernier ligne du tableau MsgBox "Dernier enregistrement atteint", vbInformation, "Gestion INSCRIPTIONS" Else 'affiche un message pour le signaler ActiveCell.Offset(1, 0).Select 'si non va su la ligne suivante Mon_text End If Dim Nblign As Integer Label8.Caption = Range("A657893").End(xlUp).Row - 1 'affiche le nombre total d'enregistrements Nblign = ActiveCell.Row - 1 'et le N° de l'enregistrement actif Label6.Caption = Nblign End Sub Private Sub UserForm_Click() End Sub '********************************************************************* ' Fontion permettant d'afficher dans les champs les données de la base '********************************************************************** Private Function Mon_text() TextBox1.Text = ActiveCell.Text TextBox2.Text = ActiveCell.Offset(0, 1).Text If ActiveCell.Offset(0, 2).Text = "H" Then SexH = True Else SexH = False If ActiveCell.Offset(0, 3).Text = "F" Then SexF = True Else SexF = False TextBox3.Text = ActiveCell.Offset(0, 4).Text If ActiveCell.Offset(0, 5).Text = "" Then TextBox4.Text = "" Else TextBox4.Text = CDate(ActiveCell.Offset(0, 5).Text) TextBox5.Text = ActiveCell.Offset(0, 6).Text TextBox6.Text = ActiveCell.Offset(0, 7).Text TextBox7.Text = ActiveCell.Offset(0, 8).Text TextBox8.Text = ActiveCell.Offset(0, 9).Text TextBox9.Text = ActiveCell.Offset(0, 10).Text TextBox10.Text = ActiveCell.Offset(0, 11).Text TextBox11.Text = ActiveCell.Offset(0, 12).Text ComboBox1.Value = ActiveCell.Offset(0, 13).Text ComboBox2.Value = ActiveCell.Offset(0, 14).Text ComboBox3.Value = ActiveCell.Offset(0, 15).Text If ActiveCell.Offset(0, 16).Text = "C" Then VerC = True Else VerC = False If ActiveCell.Offset(0, 17).Text = "N" Then VerN = True Else VerN = False TextBox15.Text = ActiveCell.Offset(0, 18).Text If ActiveCell.Offset(0, 19).Text = "" Then TextBox16.Text = "" Else TextBox16.Text = CDate(ActiveCell.Offset(0, 19).Text) TextBox17.Text = ActiveCell.Offset(0, 20).Text End Function '******************************************************************** 'INITIALISATION DU FORMULAIRE '******************************************************************** Private Sub UserForm_Initialize() Sheets("INSCRIPTIONS").Activate 'Désigne la feuille où se trouve la base de donnée ActiveSheet.Shapes("Rectangle 3").Visible = True 'Affiche le rectangle blanc qui cache les dommées ActiveSheet.Shapes("Image 4").Visible = True 'Affiche le logo sur le rectangle blanc Cells(2, 1).Select 'se place sur la première ligne de données TextBox1.Text = Cells(2, 5) 'affiche le contenue de la ligne dans les champs du formulaire TextBox2.Text = Cells(2, 2) If Cells(2, 3) = "H" Then SexH = True Else SexH = False If Cells(2, 4) = "F" Then SexF = True Else SexF = False TextBox3.Text = Cells(2, 5) TextBox4.Text = Cells(2, 6) TextBox5.Text = Cells(2, 7) TextBox6.Text = Cells(2, 8) TextBox7.Text = Cells(2, 9) TextBox8.Text = Cells(2, 10) TextBox9.Text = Cells(2, 11) TextBox10.Text = Cells(2, 12) TextBox11.Text = Cells(2, 13) ComboBox1.Value = Cells(2, 14) ComboBox2.Value = Cells(2, 15) ComboBox3.Value = Cells(2, 16) TextBox15.Text = Cells(2, 17) If Cells(2, 8) = "C" Then VerC = True Else VerC = False If Cells(2, 19) = "N" Then VerN = True Else VerN = False TextBox16.Text = Cells(2, 20) TextBox17.Text = Cells(2, 21) Dim Nblign As Integer Label8.Caption = Range("A657893").End(xlUp).Row - 1 'Affiche le nombre d'enregistrements Nblign = ActiveCell.Row - 1 'et le N° de la ligne active Label6.Caption = Nblign If ActiveCell.Offset(1, 0) = "" Then MsgBox "Dernier enregistrement atteint" Else ActiveCell.Offset(1, 0).Select Mon_text End If Label8.Caption = Range("A657893").End(xlUp).Row - 1 Nblign = ActiveCell.Row - 1 Label6.Caption = Nblign If ActiveCell.Offset(-1, 0) = "NOM" Then MsgBox "Premier enregistrement atteint" Else ActiveCell.Offset(-1, 0).Select Mon_text End If Label8.Caption = Range("A657893").End(xlUp).Row - 1 Nblign = ActiveCell.Row - 1 Label6.Caption = Nblign With Me.ComboBox1 ComboBox1.AddItem "B200" ComboBox1.AddItem "B201" ComboBox1.AddItem "B202" ComboBox1.AddItem "B203" ComboBox1.AddItem "B204" ComboBox1.AddItem "B205" ComboBox1.AddItem "B206" ComboBox1.AddItem "B220" ComboBox1.AddItem "B221" ComboBox1.AddItem "B222" ComboBox1.AddItem "B230" ComboBox1.AddItem "B235" ComboBox1.AddItem "B240" ComboBox1.AddItem "B241" ComboBox1.AddItem "B242" ComboBox1.AddItem "B243" ComboBox1.AddItem "B260" ComboBox1.AddItem "B261" ComboBox1.AddItem "B262" ComboBox1.AddItem "B270" ComboBox1.AddItem "B271" ComboBox1.AddItem "B272" ComboBox1.AddItem "B301" ComboBox1.AddItem "B302" ComboBox1.AddItem "B303" ComboBox1.AddItem "B304" ComboBox1.AddItem "B320" ComboBox1.AddItem "B321" ComboBox1.AddItem "B330" ComboBox1.AddItem "B331" ComboBox1.AddItem "B332" ComboBox1.AddItem "B333" ComboBox1.AddItem "B334" ComboBox1.AddItem "B340" ComboBox1.AddItem "B341" ComboBox1.AddItem "B342" ComboBox1.AddItem "B355" ComboBox1.AddItem "B356" ComboBox1.AddItem "B360" ComboBox1.AddItem "B361" ComboBox1.AddItem "B362" ComboBox1.AddItem "B370" ComboBox1.AddItem "B371" ComboBox1.AddItem "B375" ComboBox1.AddItem "B376" ComboBox1.AddItem "B377" ComboBox1.AddItem "B378" ComboBox1.AddItem "B379" End With With Me.ComboBox2 ComboBox2.AddItem "B200" ComboBox2.AddItem "B201" ComboBox2.AddItem "B202" ComboBox2.AddItem "B203" ComboBox2.AddItem "B204" ComboBox2.AddItem "B205" ComboBox2.AddItem "B206" ComboBox2.AddItem "B220" ComboBox2.AddItem "B221" ComboBox2.AddItem "B222" ComboBox2.AddItem "B230" ComboBox2.AddItem "B235" ComboBox2.AddItem "B240" ComboBox2.AddItem "B241" ComboBox2.AddItem "B242" ComboBox2.AddItem "B243" ComboBox2.AddItem "B260" ComboBox2.AddItem "B261" ComboBox2.AddItem "B262" ComboBox2.AddItem "B270" ComboBox2.AddItem "B271" ComboBox2.AddItem "B272" ComboBox2.AddItem "B301" ComboBox2.AddItem "B302" ComboBox2.AddItem "B303" ComboBox2.AddItem "B304" ComboBox2.AddItem "B320" ComboBox2.AddItem "B321" ComboBox2.AddItem "B330" ComboBox2.AddItem "B331" ComboBox2.AddItem "B332" ComboBox2.AddItem "B333" ComboBox2.AddItem "B334" ComboBox2.AddItem "B340" ComboBox2.AddItem "B341" ComboBox2.AddItem "B342" ComboBox2.AddItem "B355" ComboBox2.AddItem "B356" ComboBox2.AddItem "B360" ComboBox2.AddItem "B361" ComboBox2.AddItem "B362" ComboBox2.AddItem "B370" ComboBox2.AddItem "B371" ComboBox2.AddItem "B375" ComboBox2.AddItem "B376" ComboBox2.AddItem "B377" ComboBox2.AddItem "B378" ComboBox2.AddItem "B379" End With With Me.ComboBox3 ComboBox3.AddItem "B200" ComboBox3.AddItem "B201" ComboBox3.AddItem "B202" ComboBox3.AddItem "B203" ComboBox3.AddItem "B204" ComboBox3.AddItem "B205" ComboBox3.AddItem "B206" ComboBox3.AddItem "B220" ComboBox3.AddItem "B221" ComboBox3.AddItem "B222" ComboBox3.AddItem "B230" ComboBox3.AddItem "B235" ComboBox3.AddItem "B240" ComboBox3.AddItem "B241" ComboBox3.AddItem "B242" ComboBox3.AddItem "B243" ComboBox3.AddItem "B260" ComboBox3.AddItem "B261" ComboBox3.AddItem "B262" ComboBox3.AddItem "B270" ComboBox3.AddItem "B271" ComboBox3.AddItem "B272" ComboBox3.AddItem "B301" ComboBox3.AddItem "B302" ComboBox3.AddItem "B303" ComboBox3.AddItem "B304" ComboBox3.AddItem "B320" ComboBox3.AddItem "B321" ComboBox3.AddItem "B330" ComboBox3.AddItem "B331" ComboBox3.AddItem "B332" ComboBox3.AddItem "B333" ComboBox3.AddItem "B334" ComboBox3.AddItem "B340" ComboBox3.AddItem "B341" ComboBox3.AddItem "B342" ComboBox3.AddItem "B355" ComboBox3.AddItem "B356" ComboBox3.AddItem "B360" ComboBox3.AddItem "B361" ComboBox3.AddItem "B362" ComboBox3.AddItem "B370" ComboBox3.AddItem "B371" ComboBox3.AddItem "B375" ComboBox3.AddItem "B376" ComboBox3.AddItem "B377" ComboBox3.AddItem "B378" ComboBox3.AddItem "B379" End With End Sub '******************************************************************** 'BOUTON TABLEAU DE BORD '******************************************************************** Private Sub TABLEAU_BORD_Click() Sheets("TABLEAU_DE_BORD").Activate 'Ouvre la feuille Range("A1").Select 'se place sur la cellule A1 Unload Me 'ferme le formulaire End Sub '******************************************************************** 'BOUTON SUPRESSION '******************************************************************** Private Sub Suppression_Click() 'affiche un message demandant confirmation r = MsgBox(" Confirmez-vous la suppression ? ", vbYesNo + vbInformation, "Gestion INSCRIPTIONS") If r <> 6 Then Exit Sub 'si OK, efface la ligne de données dans la base de données Selection.EntireRow.Delete End Sub '************************************************************************ 'BOUTON ENREGISTRER & QUITTER '************************************************************************ Public Sub QUITTER_Click() Dim wb As Workbook Dim response As String response = MsgBox(" Souhaitez vous vraiment quitter Excel ? ", vbYesNo + vbCritical, "Quitter Excel") Select Case response ' Si OUI Case vbYes ' Recherche toutes les applications ouvertes Sheets("TABLEAU_DE_BORD").Activate 'Ouvre la feuille TABLEAU DE BORD avant de quitter For Each wb In Application.Workbooks If wb.Name <> ThisWorkbook.Name Then 'Ferme toutes les applications sauf celle active wb.Close True 'Les enregistre End If Next Application.Quit 'Et les ferme ThisWorkbook.Close True ' puis fait de même pour l'application active Case vbNo 'Si NON Set wb = Nothing 'Ne fait rien Exit Sub End Select End Sub '************************************************************************ 'BOUTON PREMIER '************************************************************************ Private Sub PREM_Click() Cells(2, 1).Select 'Se place sur la première ligne de la base de données TextBox1.Text = Cells(2, 1) 'et affiche son contenu sur le formulaire Mon_text Dim Nblign As Integer Label8.Caption = Range("A657893").End(xlUp).Row - 1 'affiche le nombre total d'enregistrements Nblign = ActiveCell.Row - 1 'et le N° de l'enregistrement actif Label6.Caption = Nblign End Sub '************************************************************************* ' Bouton PRECEDENT '************************************************************************* Private Sub PRECED_Click() 'Si le curseur se retrouve sur la première ligne du tableau If ActiveCell.Offset(-1, 0) = "NOM" Then 'affiche un message pour le signaler MsgBox "Premier enregistrement atteint", vbInformation, "Gestion CODES" Else ActiveCell.Offset(-1, 0).Select 'si non va su la ligne précédente Mon_text End If Dim Nblign As Integer Label8.Caption = Range("A657893").End(xlUp).Row - 1 'affiche le nombre total d'enregistrements Nblign = ActiveCell.Row - 1 'et le N° de l'enregistrement actif Label6.Caption = Nblign End Sub '**************************************************************** ' Vide les champs du formulaire '**************************************************************** Private Sub Effacer_Click() 'Efface le contenu des champs du formulaire TextBox1.Text = "" 'mais pas l'enregistrement affiché qui se trouve dans la base de données TextBox2.Text = "" TextBox3.Text = "" SexH = False SexF = True TextBox4.Text = "jj/mm/aaaa" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" ComboBox1.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" TextBox15.Text = "" VerC = True VerN = False TextBox16.Text = "jj/mm/aaaa" TextBox17.Text = "" TextBox1.SetFocus 'se place sur le premier champ du formulaire [A65675].End(xlUp).Offset(1, 0).Select '.....se placer sur la derniere cellule du tableau End Sub '********************************************************************* 'Bouton Dernier enregistrement '********************************************************************* Private Sub DERN_Click() rr = [A657893].End(xlUp).Row 'Le curseur se rend sur la dernière ligne de la base de données Cells(rr, 1).Select 'et le formulaire affiche le dernier enregitrement TextBox1.Text = Cells(rr, 1) Mon_text Dim Nblign As Integer Label8.Caption = Range("A657893").End(xlUp).Row - 1 'Le N° du dernier enregistrement est affiché Nblign = ActiveCell.Row - 1 Label6.Caption = Nblign End Sub '******************************************************************** ' Ouvre la feuille de données DONNEES_CODES ' avec le bouton DONNEES_CODES du formulaire '******************************************************************* Private Sub DONNEES_CODES_Click() Sheets("DONNEES_CODES").Activate 'Ouvre la feuille ActiveSheet.Shapes("Image 2").Visible = False 'Rend invisible le logo ActiveSheet.Shapes("Rectangle 1").Visible = False 'Rend invisible le rectangle blanc pour afficher les données Range("A1").Select 'Se place sur la cellule A1 Unload Me 'ferme le formulaire End Sub '************************************************************************ 'AJOUT d'une ligne de données dans la base '************************************************************************ Private Sub Ajout_Click() Dim i As Integer Cells(ActiveCell.Row, 1) = UCase(TextBox1.Text) Cells(ActiveCell.Row, 2) = TextBox2.Text 'Ucase Converti les minuscules en majuscules If SexH = True Then SexF = False If SexH = True Then Cells(ActiveCell.Row, 3) = "H" Else Cells(ActiveCell.Row, 3) = "" If SexF = True Then SexH = False If SexF = True Then Cells(ActiveCell.Row, 4) = "F" Else Cells(ActiveCell.Row, 4) = "" 'For i = 2 To Range("a:a").End(xlDown).Row 'Si le N° entré existe déjà. 'If Cells(i, 5).Text = "" Then Cells(i, 5) = "" Else If Cells(i, 5) = TextBox3.Text Then MsgBox _ '"Ce N° d'adhérent est déjà attribué à " & Cells(i, 1).Value & " " & _ 'Cells(i, 2).Value: TextBox3.Text = " ": TextBox1.SetFocus: Exit Sub 'Si oui il stope la procédure et affiche un message 'Next i Cells(ActiveCell.Row, 5) = TextBox3.Text If TextBox4.Text = "jj/mm/aaaa" Or TextBox16.Text = "" Then Cells(ActiveCell.Row, 6) = "" Else Cells(ActiveCell.Row, 6) = CDate(TextBox4.Text) Cells(ActiveCell.Row, 7) = TextBox5.Text If Cells(ActiveCell.Row, 8) <> "" Then Cells(ActiveCell.Row, 8) = TextBox6.Text If Cells(ActiveCell.Row, 9) <> "" Then Cells(ActiveCell.Row, 9) = TextBox7.Text If Cells(ActiveCell.Row, 10) <> "" Then Cells(ActiveCell.Row, 10) = TextBox8.Text Cells(ActiveCell.Row, 11) = TextBox9.Text If TextBox10.Text = "" Then Cells(ActiveCell.Row, 12) = "" Else Cells(ActiveCell.Row, 12) = Val(TextBox10.Text) Cells(ActiveCell.Row, 13) = UCase(TextBox11.Text) Cells(ActiveCell.Row, 14) = ComboBox1.Text Cells(ActiveCell.Row, 15) = ComboBox2.Text Cells(ActiveCell.Row, 16) = ComboBox3.Text If TextBox15.Text <> "" Then Cells(ActiveCell.Row, 17) = Val(TextBox15.Text) Else Cells(ActiveCell.Row, 17) = "" If VerC = True Then VerN = False If VerC = True Then Cells(ActiveCell.Row, 18) = "C" Else Cells(ActiveCell.Row, 18) = "" If VerN = True Then VerC = False If VerN = True Then Cells(ActiveCell.Row, 19) = "N" Else Cells(ActiveCell.Row, 19) = "" If TextBox16.Text = "jj/mm/aaaa" Or TextBox16.Text = "" Then Cells(ActiveCell.Row, 20) = "" Else Cells(ActiveCell.Row, 20) = TextBox16.Text Cells(ActiveCell.Row, 21) = TextBox17.Text TextBox1.Enabled = True TextBox2.Enabled = True TextBox1.Text = "" 'Initialide les champs TextBox2.Text = "" TextBox3.Text = "" SexH = False SexF = True TextBox4.Text = "jj/mm/aaaa" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" ComboBox1.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" TextBox15.Text = "" VerC = True VerN = False TextBox16.Text = "jj/mm/aaaa" TextBox17.Text = "" TextBox1.SetFocus 'Le curseur est placé dans le premien ch& du formulaire End Sub '****************************************************************** 'Bouton MODIFICATION '****************************************************************** Private Sub Modification_Click() 'Dim y As Integer r = MsgBox(" Confirmez-vous la modification ? ", vbYesNo + vbInformation, "Gestion INSCRIPTIONS") If r <> 6 Then Exit Sub For i = 2 To Range("A:A").End(xlDown).Row If TextBox1.Text = Cells(i, 1) And TextBox2.Text = Cells(i, 2) Then TextBox1.Enabled = False TextBox2.Enabled = False If SexH = True Then SexF = False If SexH = True Then Cells(i, 3) = "H" Else Cells(i, 3) = "" If SexF = True Then SexH = False If SexF = True Then Cells(i, 4) = "F" Else Cells(i, 4) = "" Cells(i, 5) = TextBox3.Text 'For y = 2 To Range("a:a").End(xlDown).Row 'Si le N° entré existe déjà. 'If Cells(y, 5).Text = TextBox3.Text Then MsgBox _ '"Ce N° d'adhérent est déjà attribué à " & Cells(y, 1).Value & " " & _ 'Cells(y, 2).Value: TextBox3.Text = " ": TextBox3.SetFocus: Exit Sub 'il stope la procédure et affiche un message 'Next y If TextBox4.Text = "jj/mm/aaaa" Or TextBox4.Text = "" Then Cells(i, 6) = "" Else Cells(i, 6) = TextBox4.Text Cells(i, 7) = TextBox5.Text If TextBox6 <> "" Then Cells(i, 8) = TextBox6.Text Else Cells(i, 8) = "" If TextBox7 <> "" Then Cells(i, 9) = TextBox7.Text Else Cells(i, 9) = "" If TextBox8 <> "" Then Cells(i, 10) = TextBox8.Text Else Cells(i, 10) = "" Cells(i, 11) = TextBox9.Text If TextBox10.Text = "" Then Cells(i, 12) = "" Else Cells(i, 12) = Val(TextBox10.Text) Cells(i, 13) = UCase(TextBox11.Text) If ComboBox1.Text = "" Then Cells(i, 14) = "" Else Cells(i, 14) = ComboBox1.Text If ComboBox2.Text = "" Then Cells(i, 15) = "" Else Cells(i, 15) = ComboBox2.Text If ComboBox3.Text = "" Then Cells(i, 16) = "" Else Cells(i, 16) = ComboBox3.Text If TextBox15.Text = "" Then Cells(i, 17) = "" Else Cells(i, 17) = Val(TextBox15.Text) 'converti au passage les caractères en numérique If VerC = True Then VerN = False If VerC = True Then Cells(i, 18) = "C" Else Cells(i, 18) = "" If VerN = True Then VerC = False If VerN = True Then Cells(i, 19) = "N" Else Cells(i, 19) = "" If TextBox16.Text = "jj/mm/aaaa" Or TextBox16.Text = "" Then Cells(i, 20) = "" Else Cells(i, 20) = CDate(TextBox16.Text) Cells(i, 21) = TextBox17.Text End If Next i TextBox1.Enabled = True TextBox2.Enabled = True TextBox1.Text = "" 'Initialide les champs TextBox2.Text = "" TextBox3.Text = "" SexH = False SexF = True TextBox4.Text = "jj/mm/aaaa" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" ComboBox1.Value = "" ComboBox2.Value = "" ComboBox3.Value = "" TextBox15.Text = "" VerC = True VerN = False TextBox16.Text = "jj/mm/aaaa" TextBox17.Text = "" TextBox1.SetFocus 'Se place sur le premier champ du formulaire End Sub Private Sub CommandButton1_Click() UserForm9.Hide UserForm3.Show 1 End Sub
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
30 août 2017 à 20:46
30 août 2017 à 20:46
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
Modifié le 30 août 2017 à 20:54
Modifié le 30 août 2017 à 20:54
Image de l'userform avec listbox
https://img-19.ccm2.net/DOpFxpZOSHbY71En9E-6cJ3Gd9E=/626c6073e11040ea95d066b0b07d65ea/ccm-ugc/Sans_nom-2.jpg
https://img-19.ccm2.net/DOpFxpZOSHbY71En9E-6cJ3Gd9E=/626c6073e11040ea95d066b0b07d65ea/ccm-ugc/Sans_nom-2.jpg
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
Modifié le 31 août 2017 à 07:46
Modifié le 31 août 2017 à 07:46
Bonjour,
Pas d'image!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
et
l'UF Adherents est Userform3 ???
Pas d'image!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
et
l'UF Adherents est Userform3 ???
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
31 août 2017 à 10:44
31 août 2017 à 10:44
Oui, je l'avais appelée comme cela pour simplifier mon exposé mais son nom est effectivement Userform3 et l'Userform contenant la listbox est nommé Userform9.
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
31 août 2017 à 10:42
31 août 2017 à 10:42
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
31 août 2017 à 14:40
31 août 2017 à 14:40
Re,
un exemple avec passage de donnees de UF1 vers UF1 et onglet Impression avec nom colonnes en ligne
https://mon-partage.fr/f/5ltldHEN/
un exemple avec passage de donnees de UF1 vers UF1 et onglet Impression avec nom colonnes en ligne
https://mon-partage.fr/f/5ltldHEN/
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
Modifié le 31 août 2017 à 15:08
Modifié le 31 août 2017 à 15:08
Re aussi
Merci pour cet exemple, mais j'aurais voulu que la colonne A de l'impression corresponde en fait à la ligne 1 du tableau en jaune, de manière à ce que l'on sache à quoi correspond chaque élément de la colonne B.
dans le style
1 30
2 FAUX
3 VRAI
4 33
5 34
Merci pour cet exemple, mais j'aurais voulu que la colonne A de l'impression corresponde en fait à la ligne 1 du tableau en jaune, de manière à ce que l'on sache à quoi correspond chaque élément de la colonne B.
dans le style
1 30
2 FAUX
3 VRAI
4 33
5 34
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
>
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
31 août 2017 à 17:40
31 août 2017 à 17:40
Re,
Ben, le titre des colonnes ne changent pas, je suppose, ecrivez les en colonne A et ecrire par le code les infos en colonne B
Ben, le titre des colonnes ne changent pas, je suppose, ecrivez les en colonne A et ecrire par le code les infos en colonne B
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
>
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
31 août 2017 à 17:43
31 août 2017 à 17:43
Effectivement, c'est tout bête mais il fallait y penser. Merci beaucoup
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
>
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
31 août 2017 à 18:32
31 août 2017 à 18:32
Re
Juste une rectif pour le resize, c'est 21,1
Juste une rectif pour le resize, c'est 21,1
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
31 août 2017 à 18:34
31 août 2017 à 18:34
Oui, j'avais rectifié, Merci encore
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
1 sept. 2017 à 23:00
1 sept. 2017 à 23:00
Re.
Comment fait-on pour vous transmettre un fichier ?
Comment fait-on pour vous transmettre un fichier ?
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
2 sept. 2017 à 07:20
2 sept. 2017 à 07:20
Bonjour,
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : https://www.cjoint.com/
Parametre le type de diffusion si par defaut ne convient pas
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
ou
'mon partage
https://mon-partage.fr/
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : https://www.cjoint.com/
Parametre le type de diffusion si par defaut ne convient pas
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
ou
'mon partage
https://mon-partage.fr/
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
2 sept. 2017 à 09:52
2 sept. 2017 à 09:52
Bonjour
voici le lien pour mon fichier.
https://www.cjoint.com/c/GIchWx6zLfw
J'ai vidé les tableaux car ils contenaient des données confidentielles, ce qui fait que le programme ne tourne plus exactement comme il le devrait.
voici le lien pour mon fichier.
https://www.cjoint.com/c/GIchWx6zLfw
J'ai vidé les tableaux car ils contenaient des données confidentielles, ce qui fait que le programme ne tourne plus exactement comme il le devrait.
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
2 sept. 2017 à 10:34
2 sept. 2017 à 10:34
Je précise également que vu mes connaissances, je n'ai fait qu'adapter à mes besoins des morceaux de code trouvés par-ci par-là. Il est fort probable qu'il y ait moyen de faire beaucoup mieux avec moins de code mais du moment que ça marche, moi ça me va.
Encore merci pour votre aide.
Encore merci pour votre aide.
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
2 sept. 2017 à 10:49
2 sept. 2017 à 10:49
Re
Ok, je récupéré le fichier
Ok, je récupéré le fichier
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
4 sept. 2017 à 07:57
4 sept. 2017 à 07:57
Bonjour,
Je vois cela dans la journee, petit probleme logistique
Je vois cela dans la journee, petit probleme logistique
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
4 sept. 2017 à 09:00
4 sept. 2017 à 09:00
Bonjour,
Faites comme chez vous, prenez le temps qu'il vous faudra. D'une part il n'y a pas une grande urgence et d'autre part, je serais également pas mal occupé aujourd'hui.
C'est fou la vie d'un retraité, on est toujours débordé ...
Faites comme chez vous, prenez le temps qu'il vous faudra. D'une part il n'y a pas une grande urgence et d'autre part, je serais également pas mal occupé aujourd'hui.
C'est fou la vie d'un retraité, on est toujours débordé ...
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
>
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
4 sept. 2017 à 12:34
4 sept. 2017 à 12:34
Re,
fichier modifie, mais a vous de voir pour le bouton impression car si click sur une ligne listbox retour sur UF3. Donc voir si doubleclick listbox au lieu de click
http://www.cjoint.com/c/GIekIpPhPEf
fichier modifie, mais a vous de voir pour le bouton impression car si click sur une ligne listbox retour sur UF3. Donc voir si doubleclick listbox au lieu de click
http://www.cjoint.com/c/GIekIpPhPEf
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
4 sept. 2017 à 13:08
4 sept. 2017 à 13:08
Re.
Merci beaucoup,
Je télécharge maintenant mais je ne pourrais voir ce que ça donne que ce soir.
Je vous tiens au courant dès demain matin.
Merci beaucoup,
Je télécharge maintenant mais je ne pourrais voir ce que ça donne que ce soir.
Je vous tiens au courant dès demain matin.
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
>
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
4 sept. 2017 à 13:31
4 sept. 2017 à 13:31
Re,
Ca roule
Ca roule
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
4 sept. 2017 à 20:59
4 sept. 2017 à 20:59
Re.
Après plusieurs essais, ça ne fonctionne pas. L'UF3 s'ouvre systématiquement sur la première ligne du tableau et non sur celle sélectionnée dans la ListBox.
Par contre, au lieu de mettre le code au niveau du clik sur la ListBox, je l'ai mis sur le bouton "RETOUR FORMULAIRE" comme cela plus de problème avec l'impression et comme le but est entre autre de retourner sur le formulaire, ça va très bien.
Reste plus qu'à trouver pourquoi ce n'est pas la bonne ligne qui s'affiche au retour dans l'UF3
Après plusieurs essais, ça ne fonctionne pas. L'UF3 s'ouvre systématiquement sur la première ligne du tableau et non sur celle sélectionnée dans la ListBox.
Par contre, au lieu de mettre le code au niveau du clik sur la ListBox, je l'ai mis sur le bouton "RETOUR FORMULAIRE" comme cela plus de problème avec l'impression et comme le but est entre autre de retourner sur le formulaire, ça va très bien.
Reste plus qu'à trouver pourquoi ce n'est pas la bonne ligne qui s'affiche au retour dans l'UF3
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
5 sept. 2017 à 12:20
5 sept. 2017 à 12:20
Je précise:
Dans le fichier que vous m'avez transmis, ça fonctionne,
Mais si je prend le code et que je le colle dans mon fichier d'origine avec toutes les données, ca ne fonctionne plus. Pourtant, je n'ai rien changé de plus que ce que ce qui suit:
Votre code d'origine :
déplacé sur le bouton :
J'ai également rajouté dans le Module1:
Avez-vous modifié autre chose que je n'aurais pas vu et qui expliquerait cela ?
Dans le fichier que vous m'avez transmis, ça fonctionne,
Mais si je prend le code et que je le colle dans mon fichier d'origine avec toutes les données, ca ne fonctionne plus. Pourtant, je n'ai rien changé de plus que ce que ce qui suit:
Votre code d'origine :
'Private Sub ListBox1_Click() ' Erase TInfos ' For i = 0 To 20 ' TInfos(i) = ListBox1.List(Me.ListBox1.ListIndex, i) ' Next i ' Flg_TI = True ' Unload Me ' UserForm3.Show 'End Sub
déplacé sur le bouton :
Private Sub CommandButton1_Click() Erase TInfos For i = 0 To 20 TInfos(i) = ListBox1.List(Me.ListBox1.ListIndex, i) Next i Flg_TI = True Unload Me UserForm3.Show End Sub
J'ai également rajouté dans le Module1:
Public Flg_TI As Boolean
Avez-vous modifié autre chose que je n'aurais pas vu et qui expliquerait cela ?
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
5 sept. 2017 à 13:31
5 sept. 2017 à 13:31
Re,
fichier qui marche: http://www.cjoint.com/c/GIflAOeqXpf
Il y a aussi des modifs dans Userform3 qui figurent deja dans le fichier precedent, au cas ou vous recopiez les modifs, notamment
et
fichier qui marche: http://www.cjoint.com/c/GIflAOeqXpf
Il y a aussi des modifs dans Userform3 qui figurent deja dans le fichier precedent, au cas ou vous recopiez les modifs, notamment
Private Sub UserForm_Initialize()
et
'retour de UF9 Private Sub UserForm_Activate()
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
5 sept. 2017 à 14:36
5 sept. 2017 à 14:36
Re.
Effectivement, je n'avais pas vu ces changements.
Maintenant ça marche impeccablement.
Merci beaucoup pour votre patience et votre aide.
Effectivement, je n'avais pas vu ces changements.
Maintenant ça marche impeccablement.
Merci beaucoup pour votre patience et votre aide.
f894009
Messages postés
17240
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
18 février 2025
1 713
5 sept. 2017 à 17:57
5 sept. 2017 à 17:57
Re,
Si vous avez besoin d'autre chose, pas de probleme
Si vous avez besoin d'autre chose, pas de probleme
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
7 sept. 2017 à 11:17
7 sept. 2017 à 11:17
Bonjour
comment enlever les pointillés qui entourent une sélection de cellules une fois que l'on a plus besoin de cette sélection (en vba)
C'est juste une question d’esthétique, cela n'interfère en rien dans le programme.
Merci
comment enlever les pointillés qui entourent une sélection de cellules une fois que l'on a plus besoin de cette sélection (en vba)
C'est juste une question d’esthétique, cela n'interfère en rien dans le programme.
Merci
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 754
7 sept. 2017 à 12:31
7 sept. 2017 à 12:31
Bonjour,
Peut-être :
Peut-être :
Application.CutCopyMode = False
TitiPointCom67
Messages postés
38
Date d'inscription
vendredi 25 août 2017
Statut
Membre
Dernière intervention
12 septembre 2017
7 sept. 2017 à 12:34
7 sept. 2017 à 12:34
Re
Non, ça ne fonctionne pas.
Non, ça ne fonctionne pas.