Liste sélective dans listbox

[La Vouivre]

Bonjour amis du forum
J'ai télécharger l'annuaire v1 de notre ami Nantouillet à l'adresse :

Excel Downloads - Annuaire

sur Fil de discussion dédié à ce programme ,j'ai trouvé le mot de passe pour ouvrir le VBA = crapoto

je cherche comment modifier le VBA pour que j'ai uniquement la liste sélectionner de la feuille Annuaire dans la listbox1 de l'userform1
Par exemple je sélectionne la lettre "B" , avec l'userform1 , j'ai tous les noms commençant par "B" sur la feuille Annuaire ,je voudrais avoir cette liste dans la listbox et non tous le personnel de la basse de données
le fichier et trop gros pour que je puisse le transmettre excusez moi pour cela
Merci pour votre aide
bon weekend à tous

 

[Staple1600]

Re : Liste sélective dans listbox

Bonjour à tous


LaVouivre
Avant d'ouvrir un second fil, alors qu'un premier existe déjà
https://www.excel-downloads.com/threads/erreur-6-sur-un-annuaire.226259/
il serait peut-être opportun que tu donnes des nouvelles dans ce premier fil justement ...

 

[Speel]

Re : Liste sélective dans listbox

Bonsoir,
Tu veux que l'userform1 (enregistrement) s'affiche quand on clique une lettre de l'userfom2 ( recherche) et que la liste corresponde à la lettre cliquée , c'est bien ça ?

 

[La Vouivre]

Re : Liste sélective dans listbox

Bonjour amis du forum
Bonjour Speel
Merci de vous intéresser à mon projet , en fait j'ai compiler les deux userform pour en faire un seul .
J'ai recopier l'userform2 dans l'userform1 ,apres quelque problème de nom ambigu je sui parvenu à avoir la liste correctement dans la listbox ,il me reste encore à pofiner le code pour pouvoir afficher dans les textbox les valeurs correspondante ,je vous passe le code que j'ai modifier avec mes annotations

code de l'userform1 modifié:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub CommandButton2_Click()
'bouton Modifier ou enregistrer une nouvelle entrée
Dim i As Long

'Minimum un nom ou un prénom
If TextBox1 = "" Then
If TextBox2 = "" Then
MsgBox "il faut au moins un nom ou un prénom SVP!!", vbCritical
Exit Sub
End If
End If


'Augmenter la vitesse d'éxécution, arreter les alertes
With Application
.Calculation = xlCalculationManual
.DisplayAlerts = False
.ScreenUpdating = False
End With
'Si une entrée du textbox est séléctionner, sauvegarder sur le nom séléctionner
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i) = True Then
With Worksheets("Base").Range("C" & i + 1)
If TextBox1.Value = "" Then .Offset(1, 0).Value = TextBox2.Value Else .Offset(1, 0).Value = TextBox1.Value
.Offset(1, -1).FormulaR1C1 = "=UPPER((LEFT(RC[1],1)))"
.Offset(1, 1).Value = TextBox2.Value
.Offset(1, 2).FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"
.Offset(1, 3).Value = TextBox3.Value
.Offset(1, 4).Value = TextBox4.Value
.Offset(1, 5).Value = TextBox5.Value
.Offset(1, 6).Value = TextBox6.Value
.Offset(1, 7).Value = TextBox7.Value
.Offset(1, 8).Value = TextBox8.Value
.Offset(1, 9).Value = TextBox9.Value
.Offset(1, 10).Value = TextBox10.Value
.Offset(1, 11).Value = TextBox11.Value
.Offset(1, 12).Value = TextBox12.Value
.Offset(1, 13).Value = TextBox13.Value
.Offset(1, 14).Value = TextBox14.Value
.Offset(1, 15).Value = TextBox16.Value
''''''''''''''''''''''''''
'modif la vouivre ecrit la textbox17 dans la colonne "22"
.Offset(1, 22).Value = TextBox17.Value
.Offset(1, 21).Value = TextBox21.Value
.Offset(1, 25).Value = TextBox18.Value
.Offset(1, 23).Value = TextBox19.Value
.Offset(1, 24).Value = TextBox20.Value
.Offset(1, 26).Value = TextBox22.Value
.Offset(1, 27).Value = TextBox24.Value

''''''''''''''''''''''''
'la vouivre textbox15 = anniversaire
If TextBox15.Text <> "" Then
.Offset(1, 16).Value = CDate(TextBox15.Value)
.Offset(1, 17).FormulaR1C1 = _
"=INT((TODAY()-RC[-1])/365.25)"
.Offset(1, 18).FormulaR1C1 = _
"=IF(RC[2]=0,IF(DAY(TODAY())=DAY(RC[-2]),""Anniversaire aujourd'hui : ""&INT((TODAY()-RC[-2])/365.25)&"" ans"",IF(DAY(TODAY())<DAY(RC[-2]),""Anniversaire ce mois ci : ""&INT((TODAY()-RC[-2])/365.25)+1&"" ans"",IF(DAY(TODAY())>DAY(RC[-2]),""Anniversaire ce mois mais passer : ""&INT((TODAY()-RC[-2])/365.25)&"" ans"",2))),IF(RC[2]=1,""Anniversaire le mois prochain -""&INT((TODAY()-RC[-2])/365.25)+1&"" ans"",""Anniversaire dans ""&RC[2]&"" mois -""&INT((TODAY()-RC[-2])/365.25)+1&"" ans""))"
.Offset(1, 19).FormulaR1C1 = _
"=MONTH(RC[-3])-(MONTH(TODAY()))"
.Offset(1, 20).FormulaR1C1 = _
"=IF(RC[-1]>=0,RC[-1],IF(RC[-1]<0,12+RC[-1],12-RC[-1]))"
End If

End With
VideTextbox
End If
Next i
'sauvegarder à la dernière ligne de la base
With Worksheets("Base").Range("C3").End(xlDown)
If TextBox1.Value = "" Then .Offset(1, 0).Value = TextBox2.Value Else .Offset(1, 0).Value = TextBox1.Value
.Offset(1, -1).FormulaR1C1 = "=UPPER((LEFT(RC[1],1)))"
.Offset(1, 1).Value = TextBox2.Value
.Offset(1, 2).FormulaR1C1 = "=RC[-2]&"" ""&RC[-1]"
.Offset(1, 3).Value = TextBox3.Value
.Offset(1, 4).Value = TextBox4.Value
.Offset(1, 5).Value = TextBox5.Value
.Offset(1, 6).Value = TextBox6.Value
.Offset(1, 7).Value = TextBox7.Value
.Offset(1, 8).Value = TextBox8.Value
.Offset(1, 9).Value = TextBox9.Value
.Offset(1, 10).Value = TextBox10.Value
.Offset(1, 11).Value = TextBox11.Value
.Offset(1, 12).Value = TextBox12.Value
.Offset(1, 13).Value = TextBox13.Value
.Offset(1, 14).Value = TextBox14.Value
.Offset(1, 15).Value = TextBox16.Value
''''''''''''''''''''''''''
'modif la vouivre ecrit la textbox17 dans la colonne "22"
.Offset(1, 22).Value = TextBox17.Value
.Offset(1, 25).Value = TextBox18.Value
.Offset(1, 23).Value = TextBox19.Value
.Offset(1, 24).Value = TextBox20.Value
.Offset(1, 26).Value = TextBox22.Value
.Offset(1, 27).Value = TextBox24.Value


''''''''''''''''''''''''
'la vouivre textbox15 = anniversaire
If TextBox15.Text <> "" Then
.Offset(1, 16).Value = CDate(TextBox15.Value)
.Offset(1, 17).FormulaR1C1 = _
"=INT((TODAY()-RC[-1])/365.25)"
.Offset(1, 18).FormulaR1C1 = _
"=IF(RC[2]=0,IF(DAY(TODAY())=DAY(RC[-2]),""Anniversaire aujourd'hui : ""&INT((TODAY()-RC[-2])/365.25)&"" ans"",IF(DAY(TODAY())<DAY(RC[-2]),""Anniversaire ce mois ci : ""&INT((TODAY()-RC[-2])/365.25)+1&"" ans"",IF(DAY(TODAY())>DAY(RC[-2]),""Anniversaire ce mois mais passer : ""&INT((TODAY()-RC[-2])/365.25)&"" ans"",2))),IF(RC[2]=1,""Anniversaire le mois prochain -""&INT((TODAY()-RC[-2])/365.25)+1&"" ans"",""Anniversaire dans ""&RC[2]&"" mois -""&INT((TODAY()-RC[-2])/365.25)+1&"" ans""))"
.Offset(1, 19).FormulaR1C1 = _
"=MONTH(RC[-3])-(MONTH(TODAY()))"
.Offset(1, 20).FormulaR1C1 = _
"=IF(RC[-1]>=0,RC[-1],IF(RC[-1]<0,12+RC[-1],12-RC[-1]))"
End If
End With


'trie de la liste par ordre alphabétique
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Add Key:=Range("C3:C2072"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Base").Sort
.SetRange Range("A3:W2072")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


'sauvegarde du classeur
'ActiveWorkbook.Save

'remettre le calcul automatique, les méssages d'alerte, le travaille en arrière plan
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With

'remise à zéro des box de saisie
initlistbox
VideTextbox


End Sub

Private Sub CommandButton29_Click()
'bouton suvegarder le classeur
ActiveWorkbook.Save
End Sub

Private Sub CommandButton3_Click()
'bouton sortir ferme l'userform1
Unload UserForm1
UserForm2.Show
End Sub


Private Sub CommandButton34_Click()
'bouton 29 userform1.show = nouvelle entrée
'bouton volontairement masqué
End Sub

Private Sub CommandButton4_Click()
'bouton ouvre la page aide
Worksheets("Aide").Select
UserForm1.Hide
End Sub

Private Sub CommandButton55_Click()
'la vouivre renomme bouton5 en 55
'annuler la sélection
initlistbox
VideTextbox
End Sub

Private Sub Label1_Click()
'label nom
End Sub

Private Sub Label15_Click()
'label date anniversaire
'volontairement masqué
End Sub

Private Sub Label2_Click()
'label Prénom

End Sub

Private Sub Label20_Click()
'label statut de l'employé 17
End Sub

Private Sub ChoixNom_Click()
ligne = f.[A:A].Find(choixnom, LookIn:=xlValues).Row
majFiche
End Sub

'''''''''''''''''''''''''''''''''''''
Private Sub ListBox1_Change()
'liste du personel de l'annuaire
Dim i As Long
Dim x As Byte

With ListBox1
If .ListIndex = -1 Then Exit Sub
For i = 1 To ListBox1.ListCount
If .ListCount <= 2 Then Exit Sub
If .Selected(i) = True Then

TextBox1.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 0).Value
TextBox2.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 1).Value
TextBox15.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 16).Value
TextBox16.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 15).Value
'''''''''''''''''''''''''''''''''''''''
'modif la vouivre lit la colonne 22 dans le textbox 17
TextBox17.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 22).Value
TextBox18.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 25).Value
TextBox19.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 23).Value
TextBox20.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 24).Value
TextBox21.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 21).Value
TextBox22.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 26).Value
TextBox24.Value = Sheets("Base").Range("C" & i + 2).Offset(0, 27).Value


'''''''''''''''''''''''''''''''''''''''''



For x = 3 To 14
Me.Controls("TextBox" & x).Value = Sheets("Base").Range("C" & i + 2).Offset(0, x).Value
Next x
.Selected(i) = True
End If
Next i
End With
End Sub


Private Sub Supprimer_Click()
'suprimer l'entrée sélectionner
Dim i As Long

Application.ScreenUpdating = False

With ListBox1
If .ListIndex = -1 Then Exit Sub
For i = 1 To ListBox1.ListCount
If .ListCount <= 2 Then Exit Sub

If .Selected(i) = True Then
Sheets("Base").Cells(i + 2, 1).EntireRow.Delete
.Selected(i) = False
End If
Next i
End With

Application.ScreenUpdating = True
initlistbox
VideTextbox
End Sub



Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Textbox Nom
If TextBox1 = "" Then Exit Sub
If IsNumeric(TextBox1.Text) Then
MsgBox "Pas de chiffre pour le nom SVP...ou alors avec des lettres...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox1.Value = ""
Exit Sub
End If

End Sub

Private Sub TextBox10_Change()
'textbox MSN

End Sub

Private Sub TextBox11_Change()
'textbox n° adresse

End Sub

Private Sub TextBox12_Change()
'textbox adresse postale

End Sub

Private Sub TextBox13_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox code postal
If TextBox13 = "" Then Exit Sub

If Not IsNumeric(TextBox13.Text) Then
MsgBox "Entrer que des chiffres pour le code postal SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox13.Value = ""
Exit Sub
End If

End Sub



Private Sub TextBox14_Change()
'textbox ville
End Sub

Private Sub TextBox15_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox date anniversaire
'volontairement masqué
If TextBox15 = "" Then Exit Sub

Me.TextBox15 = Format(TextBox15, "##""/""##""/""####")

If Not IsDate(TextBox15.Text) Then
MsgBox "Entrer une date valide SVP...date éffacer!!!", vbCritical, "ATTENTION !"
TextBox15.Value = ""
Exit Sub
End If



End Sub

Private Sub TextBox16_Change()
'textbox remarque
End Sub

Private Sub TextBox17_Change()
'textbox statut de l'empoyé colonne "y" ou "25"

End Sub

Private Sub TextBox2_Change()
'textbox Prénom
End Sub


Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox portable 1
If TextBox3 = "" Then Exit Sub
mystring = TextBox3.Text

If Not IsNumeric(TextBox3.Text) Then
MsgBox "Entrer que des chiffres pour le portable 1 SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox3.Value = ""
Exit Sub
End If

If Len(mystring) < 10 Then
MsgBox "Minimum 10 chiffres il n'y en a que " & Len(mystring) & " pour le portable 1, numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox3.Value = ""
End If
Me.TextBox3 = Format(TextBox3, "0#"" ""##"" ""##"" ""##"" ""##")
End Sub

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox portable 2
If TextBox4 = "" Then Exit Sub
mystring = TextBox4.Text

If Not IsNumeric(TextBox4.Text) Then
MsgBox "Entrer que des chiffres pour le portable 2 SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox4.Value = ""
Exit Sub
End If

If Len(mystring) < 10 Then
MsgBox "Minimum 10 chiffres il n'y en a que " & Len(mystring) & " pour le portable 2, numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox4.Value = ""
End If
Me.TextBox4 = Format(TextBox4, "0#"" ""##"" ""##"" ""##"" ""##")
End Sub
Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox tel fixe
If TextBox5 = "" Then Exit Sub
mystring = TextBox5.Text

If Not IsNumeric(TextBox5.Text) Then
MsgBox "Entrer que des chiffres pour le fixe SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox5.Value = ""
Exit Sub
End If

If Len(mystring) < 10 Then
MsgBox "Minimum 10 chiffres il n'y en a que " & Len(mystring) & " pour le fixe, numéro éffacer!!! ", vbCritical, "ATTENTION !"
TextBox5.Value = ""
End If
Me.TextBox5 = Format(TextBox5, "0#"" ""##"" ""##"" ""##"" ""##")
End Sub
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox tel internet
If TextBox6 = "" Then Exit Sub
mystring = TextBox6.Text

If Not IsNumeric(TextBox6.Text) Then
MsgBox "Entrer que des chiffres pour internet SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox6.Value = ""
Exit Sub
End If

If Len(mystring) < 10 Then
MsgBox "Minimum 10 chiffres il n'y en a que " & Len(mystring) & " pour internet, numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox6.Value = ""
End If
Me.TextBox6 = Format(TextBox6, "0#"" ""##"" ""##"" ""##"" ""##")
End Sub
Private Sub TextBox7_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'textbox tel bureau
If TextBox7 = "" Then Exit Sub
mystring = TextBox7.Text

If Not IsNumeric(TextBox7.Text) Then
MsgBox "Entrer que des chiffres pour le bureau SVP...numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox7.Value = ""
Exit Sub
End If

If Len(mystring) < 10 Then
MsgBox "Minimum 10 chiffres il n'y en a que " & Len(mystring) & " pour le bureau, numéro éffacer!!!", vbCritical, "ATTENTION !"
TextBox7.Value = ""
End If
Me.TextBox7 = Format(TextBox7, "0#"" ""##"" ""##"" ""##"" ""##")
End Sub

Private Sub TextBox8_Change()
'textbox site internet
End Sub

Private Sub TextBox9_Change()
'textbox Mail
End Sub

Private Sub UserForm_Initialize()
initlistbox
End Sub

Private Sub initlistbox()
Dim c As Range
Dim x As Long '/// Dim x As Byte
Dim der As Long

Me.ListBox1.Clear

der = Sheets("Base").Range("C3").End(xlDown).Row
x = 0

For Each c In Sheets("Base").Range("C2:C" & der)
With ListBox1
.AddItem c
.List(x, 0) = c
.List(x, 1) = c.Offset(0, 1)
x = x + 1
End With
Next c

End Sub
Private Sub VideTextbox()
Dim objControl As Control

For Each objControl In UserForm1.Controls
If TypeOf objControl Is MSForms.TextBox Then
objControl.Text = ""
End If
Next
End Sub


''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''copie du code Userform2''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''
'Dim L As String ' mis en commentaire car en conflit
'la vouivre le 25/11/2014
Private Sub CheckBox1_Click()
If CheckBox1 = True Then Worksheets("Annuaire").Range("B:U").EntireColumn.AutoFit
End Sub

Private Sub CommandButton1_Click()
L = "A"
Call Recherche(L)
Range("C7").Select

End Sub

Private Sub CommandButton10_Click()
L = "J"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton11_Click()
L = "K"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton12_Click()
L = "L"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton13_Click()
L = "M"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton14_Click()
L = "Z"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton15_Click()
L = "N"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton16_Click()
L = "O"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton17_Click()
L = "P"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton18_Click()
L = "Q"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton19_Click()
L = "R"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton30_Click()
'la vouivre modif bouton 2 en 30
L = "B"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton20_Click()
L = "S"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton21_Click()
L = "T"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton22_Click()
L = "U"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton23_Click()
L = "V"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton24_Click()
L = "W"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton25_Click()
L = "X"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton26_Click()
L = "Y"
Call Recherche(L)
Range("C7").Select
End Sub


'Private Sub CommandButton29_Click()
'UserForm1.Show
'Unload UserForm2
'End Sub

Private Sub CommandButton31_Click()
'modif la vouivre commandButton3 en 31
L = "C"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton32_Click()
'modif la vouivre commandButton4 en 32
L = "D"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton33_Click()
'modif la vouivre ommandButton5 en 33
L = "E"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton6_Click()
L = "F"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton7_Click()
L = "G"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton8_Click()
L = "H"
Call Recherche(L)
Range("C7").Select
End Sub

Private Sub CommandButton9_Click()
L = "I"
Call Recherche(L)
Range("C7").Select
End Sub


Private Sub TextBox23_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'modif la vouivre textbox1 en 23
mystring = TextBox23.Text
If Len(mystring) = 10 Then If IsNumeric(TextBox23.Text) Then Me.TextBox23 = Format(TextBox1, "0#"" ""##"" ""##"" ""##"" ""##")

End Sub

'Private Sub UserForm_Initialize()
'With Me
' .startUpPosition = 3
' '.Left = Application.Width - Me.Width
'End With
'End Sub

Private Sub CommandButton27_Click()
Dim c$, ws As Worksheet: Set ws = Sheets("Base")
Set ws1 = Sheets("liaison")

Worksheets("Annuaire").Select

der_ligne = Worksheets("Base").Range("C3").End(xlDown).Row
ws1.[A1].Value = "Nom"
ws1.[A2].Value = "*"
ws.Range("B2:U" & der_ligne).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws1.Range("A1:A2"), CopyToRange:=Sheets("Annuaire").Range("B6:U6"), Unique:=False
If CheckBox1 = True Then Worksheets("Annuaire").Range("B:U").EntireColumn.AutoFit
End Sub

Private Sub CommandButton28_Click()
'la vouivre bouton recherche modif textbox1 en 23
Dim c$, ws As Worksheet: Set ws = Sheets("Base")
Set ws1 = Sheets("liaison")

Worksheets("Annuaire").Select

der_ligne = Worksheets("Base").Range("C3").End(xlDown).Row
x = TextBox23.Text
If x = "" Then Exit Sub

For Each s In Array("Base")
With Sheets(s).Cells
Set n = .Find(x, LookIn:=xlValues)
If n Is Nothing Then
MsgBox "Pas de correspondance dans la base..."
Else
ws1.Range("A1") = Sheets("Base").Range(Split(n.Address, "$")(1) & 2).Value
ws1.Range("A2") = n.Value

End If
End With
Next s
ws.Range("B2:U" & der_ligne).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws1.Range("A1:A2"), CopyToRange:=Sheets("Annuaire").Range("B6:U6"), Unique:=False
If CheckBox1 = True Then Worksheets("Annuaire").Range("B:U").EntireColumn.AutoFit
End Sub

Private Sub Recherche(L)
Dim c$, ws As Worksheet: Set ws = Sheets("Base")
Set ws1 = Sheets("liaison")

Worksheets("Annuaire").Select

ws1.[A1].Value = "Nom"
Lettre = L
der_ligne = Worksheets("Base").Range("B3").End(xlDown).Row
c = Lettre & "*"
ws1.[A2].Value = c
ws.Range("B2:U" & der_ligne).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws1.Range("A1:A2"), CopyToRange:=Sheets("Annuaire").Range("B6:U6"), Unique:=False
If CheckBox1 = True Then Worksheets("Annuaire").Range("B:U").EntireColumn.AutoFit
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Ne pas oublier que le code de départ à été fait par notre ami nantouillet qui à mis en ligne le code de déblocage sur le fil https://www.excel-downloads.com/threads/annuaire.147525/
j'arrive aujourd'hui à modifier un code uniquement par ce que j'ai appris sur ce forum merveilleux ,je n'ai aucune formation quelconque extérieure,donc je galère un peu pour pouvoir arriver à mon but ,mais avec l'aide des amis du forum je m'en sors
Bon weekend à tous
merci pour votre aide

 

[Speel]

Re : Liste sélective dans listbox

Bonsoir,
voila ce que je vois avec ton code modifié



est ce conforme à ce que tu as ?

 

[La Vouivre]

Re : Liste sélective dans listbox

Bonsoir Speel
Merci de venir m'aider dans le projet
Je vous passe une copie d'écran de ce que j'ai déja réaliser



Quand je sélectionne une lettre ,j'ai bien la liste correspondante dans la listbox1, mais Je n'arrive pas à faire correspondre la sélection en listbox1 et la recherche des textbox ,si je m'exprime correctement. Si je sélectionne un nom sur le listbox , dans les textbox n'apparais pas le bonne ligne ,j'ai un décalage de 5 lignes entre le nom sélectionner est le résultat dans les textbox et je ne trouve pas le code à changer pour aligner la sélection de la listbox et la corespondance dans le base de donnée .

 

[Staple1600]

Re : Liste sélective dans listbox

Bonsoir à tous

LaVouivre
Même les copies d'écrans doivent être anonymisées
(cf la charte du forum)
Donc, stp, mets en une qui contienne
NOM1 PRENOM1
NOM2 PRENOM2
etc...

PS: Chose qu'avait pris soin de faire Speel avec sa copie d'écran où l'on voit qu'il s'agit de données fictives

 

[La Vouivre]

Re : Liste sélective dans listbox

Merci Staple 1600 de me rappeler à l'ordre , je n'avais pas suffisamment fait attention
bonne soirée

 

[Speel]

Re : Liste sélective dans listbox

*****

Bonsoir,
ça devrai s'approcher de ce que tu veux.

 

[La Vouivre]

Re : Liste sélective dans listbox

Bonsoir les amis
Bonsoir Speel
j'ai réussi à compiler au maxi le fichier pour vous le présenter ,j'ai réussi à faire apparaitre les sélections par lettre de la feuille "annuaire" dans la listbox ;
Par contre je n'arrive pas à synchroniser la sélection de la listbox avec les textbox , j'ai supprimer volontairement certaine textbox pour alléger le fichier.
de plus je vois que l'annuaire n'est pas complètement rempli avec la feuille "base" il manque des données à droite du tableau de l'"annuaire"
la je suis bloqué je n'avance plus du tout ,que me conseillez-vous pour que je puisse synchroniser les textbox et remplir correctement l'"annuaire" par rapport à la "base"
bonne soirée à tous

 

[Speel]

Re : Liste sélective dans listbox

la je suis bloqué je n'avance plus du tout ,que me conseillez-vous pour que je puisse synchroniser les textbox et remplir correctement l'"annuaire" par rapport à la "base"
bonne soirée à tous

bonsoir,
ça part dans tous les sens ... faut nettoyer.
question c'est quoi ce module de class ?

 

[La Vouivre]

Re : Liste sélective dans listbox

Bonsoir Speel
désolé pour mon ignorance ,mais le module de classe est dans le fichier d'origine, et je ne sais pas la fonction qu'il rempli.

 

[Speel]

Re : Liste sélective dans listbox

Regarde comme ça ...

Attention brut de décoffrage , plein de codes inutiles et autres modif a faire avant de prétendre utiliser ce fichier en "production"

 

[La Vouivre]

Re : Liste sélective dans listbox

Merci Speel il me semble fonctionner , demain je vais faire des essais en grandeur 1
pourrais-tu me dire quelles lignes de code tu a modifier .

 

[Speel]

Re : Liste sélective dans listbox

J'ai modifié :

 Private Sub Workbook_Open()
'la vouivre ouvre le fichier sur la feuille "annuaire" et l'userform2

Worksheets("Annuaire").Activate

End Sub

dont j'ai déplacé une partie du code dans la feuil1 et mis dans le bon ordre !

Private Sub Worksheet_Activate()
With Range("B6")
.Select
.FormulaR1C1 = "=Base!R[-4]C"
.AutoFill Destination:=Range("B6:AE6"), Type:=xlFillDefault
''''''''''''''''''''''''''''''''''''''''''''''''''
'.AutoFill Destination:=Range("B6:AE2000"), Type:=xlFillDefault
End With
UserForm1.Show
End Sub

j'ai mis l'option explicit et forcément déclaré les variables, indispensable !

j'ai mis en commentaire les liens des textbox inexistants dans l'userform, pas effacés je pense que tu vas t'en servir ,

'modif la vouivre ecrit la textbox17 dans la colonne "22"
        '.Offset(1, 22).Value = TextBox17.Value
        '.Offset(1, 21).Value = TextBox21.Value
        '.Offset(1, 25).Value = TextBox18.Value
        '.Offset(1, 23).Value = TextBox19.Value
        '.Offset(1, 24).Value = TextBox20.Value
        '.Offset(1, 26).Value = TextBox22.Value
        '.Offset(1, 27).Value = TextBox24.Value

en commentaire aussi , ce code qui ne correspond a rien :

'Private Sub ChoixNom_Click()
'  ligne = f.[A:A].Find(choixnom, LookIn:=xlValues).Row
'  majFiche
'End Sub

j'ai viré le module de classe qui fait référence à une feuille inexistante, et qui sert à rien.


modifié base en annuaire et mis la valeur 6 au lieu de 2 dans les lignes "textbox Value = ..........."

With ListBox1
If .ListIndex = -1 Then Exit Sub
For i = 1 To ListBox1.ListCount
If .ListCount <= 2 Then Exit Sub
    If .Selected(i) = True Then
    'la vouivre : lit la valeur dans le listbox1 et recherche la valeur dans la feuille annuaire
    TextBox1.Value = Sheets("Annuaire").Range("C" & i + 6).Offset(0, 0).Value
    TextBox2.Value = Sheets("Annuaire").Range("C" & i + 6).Offset(0, 1).Value
    TextBox15.Value = Sheets("Annuaire").Range("C" & i + 6).Offset(0, 16).Value
    TextBox16.Value = Sheets("Annuaire").Range("C" & i + 6).Offset(0, 15).Value
    '''''''''''''''''''''''''''''''''''''''
    'modif la vouivre lit la colonne 22 dans le textbox 17

idem pour celle là

For x = 3 To 14
        Me.Controls("TextBox" & x).Value = Sheets("annuaire").Range("C" & i + 6).Offset(0, x).Value
        Next x

modifié les lignes 792 et 810 :

ws.Range("B2:AE" & der_ligne).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=ws1.Range("A1:A2"), CopyToRange:=Sheets("Annuaire").Range("B6:AE6"), Unique:=False
If CheckBox1 = True Then Worksheets("Annuaire").Range("B:AE").EntireColumn.AutoFit

d'ailleurs j'ai oublié la ligne 760

je crois que c'est tout

je répète , c'est loin d'être optimisé et exempt d'anomalies.