Signaler

Extraction de listbox. [Résolu]

Posez votre question TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - Dernière réponse le 7 sept. 2017 à 12:34 par TitiPointCom67
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.
Utile
+1
plus moins
http://img-19.ccm2.net/DOpFxpZOSHbY71En9E-6cJ3Gd9E=/626c6073e11040ea95d066b0b07d65ea/ccm-ugc/Sans_nom-1.jpg
Donnez votre avis
Utile
+1
plus moins
Bonjour
voici le lien pour mon fichier.
http://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.
Donnez votre avis
Utile
+0
plus moins
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 ;)
Donnez votre avis
Utile
+0
plus moins
Qu'entendez-vous par fichier exemple ?
Dois-je joindre le code déjà existant ?
fabien25000 188Messages postés mercredi 5 octobre 2016Date d'inscription 20 septembre 2017 Dernière intervention - 30 août 2017 à 20:26
surtout un fichier qui ne dévoile rien qui puisse etre confidentiel oui
Répondre
Donnez votre avis
Utile
+0
plus moins
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


Donnez votre avis
Utile
+0
plus moins
Image de l'userform avec listbox
http://img-19.ccm2.net/DOpFxpZOSHbY71En9E-6cJ3Gd9E=/626c6073e11040ea95d066b0b07d65ea/ccm-ugc/Sans_nom-2.jpg
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 31 août 2017 à 07:45
Bonjour,

Pas d'image!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
et
l'UF Adherents est Userform3 ???
Répondre
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 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.
Répondre
Donnez votre avis
Utile
+0
plus moins
http://img-19.ccm2.net/QuTkk28FjGFC4M_gOC0WO9xMz2Q=/90fe512ae6ff4a19841e4c6f6091ad8b/ccm-ugc/Sans_nom-2.jpg
Donnez votre avis
Utile
+0
plus moins
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/
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 1 sept. 2017 à 12:57
Bonjour,
Ben c'est tout dans le fichier exemple. Quand vous selectionnez une ligne, une uf s'ouvre et mise a jour de trois objets(a vous de voir pour vos 21 objets a mettre a jour dans votre fichier).
Quand vous avez teste le bouton Impression, vous n'avez rien remarque ??
Répondre
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 1 sept. 2017 à 13:20
Bonjour,
A vrai dire non, à part que la feuille Impression se remplie.
D'ailleurs je suis arrivé à le transposer dans mon programme et ça marche impeccable.
Par contre, je n'ai pas saisi à quoi servent les OptionButton 1 et 2 car je ne voie aucun changement que je coche l'un ou l'autre.
Comme je vous l'ai dit au départ, je ne suis pas une lumière alors éclairez-moi SVP.
Répondre
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 1 sept. 2017 à 14:01
Re,

le fichier exemple est fait pour mettre a jour les objets d'une autre UF et preparer une impression de cellules, pas plus. Maintenant a vous de dire ce que vous voulez car je n'ai repondu qu'a votre demande precdente!!!!
Répondre
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 1 sept. 2017 à 15:28
Re.
J'ai bien compris pour l'impression, par contre, je ne saisi pas à quel endroit du fichier exemple on met à jour une autre UF.
Répondre
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 1 sept. 2017 à 18:50
Re,

Sans votre fichier, pas vraiment possible de vous aider......
Répondre
Donnez votre avis
Utile
+0
plus moins
Re.
Comment fait-on pour vous transmettre un fichier ?
Donnez votre avis
Utile
+0
plus moins
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 : http://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/
Donnez votre avis
Utile
+0
plus moins
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.
Donnez votre avis
Utile
+0
plus moins
Re
Ok, je récupéré le fichier
Donnez votre avis
Utile
+0
plus moins
Bonjour,
Je vois cela dans la journee, petit probleme logistique
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 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
Répondre
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 5 sept. 2017 à 07:58
Bonjour,

Après plusieurs essais, ça ne fonctionne pas. L'UF3 s'ouvre
Nous somme d'accord, c'est bien apres avoir fait une recherche? Je regarde la chose

Petite question:
Vous avez reportez le code de la procedure
Private Sub ListBox1_Click()
dans la procedure du bouton
Private Sub CommandButton1_Click()
??????
Répondre
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 5 sept. 2017 à 08:32
Bonjour,
Oui effectivement, c'est ce que j'ai fais, mais après avoir effectué mes essais sans rien changer à votre version et constaté que cela ne fonctionnait pas.
Une fois le changement effectué, le résultat était exactement le même.
Répondre
TitiPointCom67 38Messages postés vendredi 25 août 2017Date d'inscription 12 septembre 2017 Dernière intervention - 5 sept. 2017 à 09:28
Précision:
Oui, c'est bien après avoir fait une recherche, comme pour l'impression mais au lieu que la ligne sélectionnée s'imprime, je veux qu'elle s'affiche dans l'UF3.
Comme pour l'impression, il suffit de cliquer sur le bouton impression, et non directement sur la listbox, qui ne sert finalement qu'à sélectionner la ligne que l'on veut soit imprimer soit afficher dans lUF3 en fonction du bouton sur lequel on va cliquer.
Répondre
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 5 sept. 2017 à 09:59
Re,

Vous pouvez montrer le code du Bouton
 Private Sub CommandButton1_Click()

parce que chez moi, j'ai fait la modif et ca marche
Répondre
Donnez votre avis
Utile
+0
plus moins
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 :
'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 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 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
Private Sub UserForm_Initialize()

et
'retour de UF9
Private Sub UserForm_Activate()
Répondre
Donnez votre avis
Utile
+0
plus moins
Re.
Effectivement, je n'avais pas vu ces changements.
Maintenant ça marche impeccablement.
Merci beaucoup pour votre patience et votre aide.
f894009 12107Messages postés dimanche 25 novembre 2007Date d'inscription 20 septembre 2017 Dernière intervention - 5 sept. 2017 à 17:57
Re,
Si vous avez besoin d'autre chose, pas de probleme
Répondre
Donnez votre avis
Utile
+0
plus moins
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
pijaku 12206Messages postés jeudi 15 mai 2008Date d'inscription ModérateurStatut 13 septembre 2017 Dernière intervention - 7 sept. 2017 à 12:31
Bonjour,
Peut-être :
Application.CutCopyMode = False
Répondre
Donnez votre avis
Utile
+0
plus moins
Re
Non, ça ne fonctionne pas.
Donnez votre avis

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !