Annuaire

roxise

XLDnaute Nouveau
bonjour,
voilà je suis toujours en développement de mon annuaire téléphonique, malheureusement, j'ai dû rencontré un petit bug d’exécution en changeant les noms des onglets, merci de me donner un cout de pousse en urgence pour finaliser mon travail..


Dim tablotemp As Variant

Private Sub CommandButton1_Click()
If TextBox1 <> "" Then Recherche
End Sub

Private Sub Worksheet_Activate()
charger_liste
End Sub


Private Sub charger_liste()

With Sheets("Liste Agents")
tablotemp = .Range("A2:x" & .Range("A65536").End(xlUp).Row).Value
End With

With Sheets("consult_FicheAgent").ListBox1
.ColumnCount = 24 'calibre la listBox 1 à colonnes de 0 à 5
.ColumnWidths = "40;80;90;80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
.List = tablotemp
End With
End Sub
Private Sub ListBox1_Click()

With Sheets("consult_FicheAgent")
.Range("consult_FicheAgent") = tablotemp(Sheets("consult_FicheAgent").ListBox1.ListIndex + 1, 1)
End With

End Sub
Private Sub Recherche() 'au changement dans la TextBox1
'Dim c As Range 'déclare la variable c
'Dim pa As String 'déclare la variable pa
'Dim X As Integer 'déclare la variable x
'
'Set f = Sheets("Liste Agents") 'définit la variable f
'lf = f.Range("A65536").End(xlUp).Row 'définit la variable lf
'Set deux = f.Range("A2:D" & lf) 'définit la variable deux
'
'
'ListBox1.Clear 'vide la ListBox1
'X = 0 'définit la variable x
'
'With deux 'prend en compte la plage deux
' Set c = .Find(TextBox1.Value, Range("A2"), xlValues, xlPart) 'définit la variable c (=chercher : ctrl F)
'
' If Not c Is Nothing Then 'condition 1 : si c existe
' pa = c.Address 'définit la variable pa (premmière adressse de c)
' Do 'éxécute
' ' If c.Column = 1 Then 'condition 2 : si la colonne de c est 1
' ListBox1.AddItem c.Row 'ajoute la valeur de c à la ListBox1 (colonne 0)
' ListBox1.Column(1, X) = c.Offset(0, 1).Value 'ajoute la valeur de la cellule à droite de c (colonne1)
' X = X + 1 'redéfinit la variaqble x
' Set c = .FindNext(c) 'redéfinit la variable c (prochaine occurence)
'
' Loop While Not c Is Nothing And c.Address <> pa 'boucle tant que l'adresse de c est différente de pa
' End If 'fin de la condition 1
'
'End With 'fin de la prise en compte de la plage deux
Dim PremCel As String, Tbl() As Variant
Dim Cel As Range, I As Integer, L As Integer, Li As Integer

With Sheets("Liste Agents").Range("A1:D" & Sheets("Liste Agents").Range("A65536").End(xlUp).Row)

Set Cel = .Find(TextBox1)
If Not Cel Is Nothing Then
PremCel = Cel.Address
Do
If Cel.Row > 1 Then
'code client
If IsNumeric(TextBox1) And Cel.Column = 1 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Cel.Row

End If
'nom ou prénom
If Not IsNumeric(TextBox1) And Cel.Column = 3 Or Cel.Column = 4 Then
I = I + 1
ReDim Preserve Tbl(1 To I)
Tbl(I) = Cel.Row
End If
End If
Set Cel = .FindNext(Cel)

Loop Until Cel.Address = PremCel
End If

End With

If I = 0 Then Exit Sub

With Sheets("Liste Agents")
tablotemp = .Range("A2:x" & .Range("A65536").End(xlUp).Row).Value
End With

With Sheets("consult_FicheAgent").ListBox1
.Clear
.ColumnCount = 24 'calibre la listBox1 à 24 colonnes de 0 à 24-1(ColumnCount-1)
.ColumnWidths = "40;80;90;80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
For L = 1 To UBound(Tbl)
For Li = 1 To UBound(tablotemp, 1)
If Li = Tbl(L) - 1 Then
.AddItem tablotemp(Li, 1)
For c = 2 To UBound(tablotemp, 2)
.List(.ListCount - 1, c - 1) = tablotemp(Li, c)
Next c
End If
Next Li
Next L
End With
'End If



End Sub
 

Pièces jointes

  • rechercheV6.xls
    114 KB · Affichages: 75
G

Guest

Guest
Re : Annuaire

Bonjour,

ici c'est un site de bénévole. Pas un site de production.

La seule erreur que j'ai eu sur ton fichier, n'a rien à voir avec les noms de feuilles mais avec des vides dans 'tablotemp'. résolu en chargeant la listBox comme ceci:
Code:
    With Sheets("consult_FicheAgent").ListBox1
        .Clear
        .ColumnCount = 24    'calibre la listBox1 à 24 colonnes de 0 à 24-1(ColumnCount-1)
        .ColumnWidths = "40;80;90;80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0"
        .List = tablotemp
    End With

Autre erreur ici:
dans .Range("consult_FicheAgent") quel Range, Quelle(s) cellule(s)? La destination n'est pas définie dans consult_FicheAgent.
Code:
 Private Sub ListBox1_Click()
    With Sheets("consult_FicheAgent")
        .Range("consult_FicheAgent") = tablotemp(Sheets("consult_FicheAgent").ListBox1.ListIndex + 1, 1)
    End With
End Sub

Il suffit, si je ne m'abuse de remplacer .range("consult_FicheAgent") par .range("consult_codeclient")


A+
 
Dernière modification par un modérateur:

roxise

XLDnaute Nouveau
Re : Annuaire

rebonjour,
je te merci de m'avoir aider, je vais tester et te faire un retour, par ailleurs, je sais bien que c'est un site bénévole mais le malheur c'est que je n'ai trouvé aucune aide ailleurs et, étant pris par le temps.
je te remercie encore une fois. take care:)
 

Discussions similaires

Réponses
4
Affichages
194

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa