Problème insertion fonction recherche V dans un userform

Toscamyl

XLDnaute Nouveau
Bonjour à tous,

Je travaille actuellement sur la création d'un userform pour mon boulot.

Ce userform me permet de renseigner pour chaque utilisateur le type de logiciel qu'il utilise et le typ de profil qu'il a sur chaque logiciel.

Dans mon formulaire j'ai réussi à faire des combobox en cascade
et a enregistrer tous ce que je saisie ou selectionne dans mon formulaire dans une feuille excel qui me sert de base de données.

Par contre je rencontre un problème que je n'arrive pas à contourner :

J'essaie d'afficher automatiquement (type recherche v) des informations dans des texbox lorsque que je selectionne le combobox Application4
et ca ne marche pas !! je ne comprend pas pourquoi

Voici le code que j'ai peniblement réussi à faire marché
Je suis une vraie "quiche lorraine" en VBA

J'aurai bien voulu mettre un fichier exemple mais les données sont confidentielles

Merci d'avance pour votre aide

Le code :

Option Explicit
Dim TabTemp As Variant


Private Sub UserForm_Initialize()
Dim L As Long
'Mémoriser le tableau de données avec une colonne supplémentaire qui servira à la
'gestion des niveaux d'alimentation des combobox
With Sheets(3)
L = .Range("A65536").End(xlUp).Row
TabTemp = .Range(.Cells(1, 1), .Cells(L, 5)).Value
End With
MAJCombo Localisation, 0

End Sub

Private Sub Localisation_Change()
Dim L As Long
'Remise à zéro des niveaux
For L = 1 To UBound(TabTemp, 1)
TabTemp(L, 5) = 0
Next L
'MAJ du combo n°2 avec un flag de niveau 1
MAJCombo Immeuble, 1, Localisation.Text

End Sub

Private Sub Immeuble_Change()
'MAJ du combo n°3 avec un flag de niveau 2
MAJCombo Application4, 2, Immeuble.Text
MAJCombo Application5, 2, Immeuble.Text
MAJCombo Application6, 2, Immeuble.Text
MAJCombo Application7, 2, Immeuble.Text
MAJCombo Application8, 2, Immeuble.Text
MAJCombo Application9, 2, Immeuble.Text

End Sub

Private Sub Application4_Change()

'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil4, 3, Application4.Text

Dim cell As Range
Dim cherch
Dim derlign As Long

derlign = Sheets("Listes").Range("f65536").End(xlUp).Row

cherch = Application4

Set cell = Sheets("Liste2").Range("f1:f" & derlign).Find(cherch, lookAt:=xlWhole)
If Not cell Is Nothing Then

Etat4.Value = cell.Offset(0, 1)
Entité4.Value = cell.Offset(0, 3)
Service4.Value = cell.Offset(0, 2)


End If

End Sub


Private Sub Application5_Change()
'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil5, 3, Application5.Text
End Sub

Private Sub Application6_Change()
'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil6, 3, Application6.Text
End Sub

Private Sub Application7_Change()
'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil7, 3, Application7.Text
End Sub

Private Sub Application8_Change()
'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil8, 3, Application8.Text
End Sub

Private Sub Application9_Change()
'MAJ du combo n°4 avec un flag de niveau 3
MAJCombo Profil9, 3, Application9.Text
End Sub

Private Sub MAJCombo(Combo As ComboBox, Niv As Byte, Optional V As String)
Dim Coll As New Collection
Dim L As Long
'Gestion du flag de niveau dans la colonne supplémentaire (5) du tableau
For L = 1 To UBound(TabTemp, 1)
If Niv = 0 Then
'RAZ du flag de niveau
TabTemp(L, 5) = 0
Else
TabTemp(L, 5) = Application.WorksheetFunction.Min(TabTemp(L, 5), Niv - 1)
'Si l'élément est retenu alors on incrémente le flag de niveau
If TabTemp(L, Niv) = V Then
TabTemp(L, 5) = TabTemp(L, 5) + 1
End If
End If
Next L
'Détermination de la liste sans doublon
On Error Resume Next
For L = 1 To UBound(TabTemp, 1)
If TabTemp(L, 5) = Niv Then
Coll.Add TabTemp(L, Niv + 1), CStr(TabTemp(L, Niv + 1))
End If
Next L
On Error GoTo 0
'Mise à jour du combobox
Combo.Clear
For L = 1 To Coll.Count
Combo.AddItem Coll.Item(L)
Next L
End Sub

Private Sub Enregistrer_Click()

'On teste la saisie du nom...
If Me.Nom.Text = "" Then
MsgBox "Vous devez entrer un nom...!!"
Me.Nom.SetFocus
Exit Sub
End If
'On teste la saisie du prénom...
If Me.Prenom.Text = "" Then
MsgBox "Vous devez entrer un prénom...!!"
Me.Prenom.SetFocus
Exit Sub
End If
'On teste la saisie du matricule...
If Me.Matricule.Text = "" Then
MsgBox "Vous devez entrer un matricule...!!"
Me.Matricule.SetFocus
Exit Sub
End If
'On teste la saisie de la Fonction...
If Me.Fonction.Text = "" Then
MsgBox "Vous devez entrer une fonction...!!"
Me.Fonction.SetFocus
Exit Sub
End If
'On teste la saisie de la Localisation...
If Me.Localisation.Text = "" Then
MsgBox "Vous devez entrer une Localisation...!!"
Me.Localisation.SetFocus
Exit Sub
End If
'On teste la saisie de l'immeuble...
If Me.Immeuble.Text = "" Then
MsgBox "Vous devez entrer un immeuble...!!"
Me.Immeuble.SetFocus
Exit Sub
End If
'On teste la saisie de l'étage...
If Me.Etage.Text = "" Then
MsgBox "Vous devez entrer un étage...!!"
Me.Etage.SetFocus
Exit Sub
End If
'On teste la saisie du bureau...
If Me.Bureau.Text = "" Then
MsgBox "Vous devez entrer un n° de bureau...!!"
Me.Bureau.SetFocus
Exit Sub
End If
'On teste la saisie du bureau...
If Me.Bureau.Text = "" Then
MsgBox "Vous devez entrer un n° de bureau...!!"
Me.Bureau.SetFocus
Exit Sub
End If
'On teste la saisie du contrat...
If Me.Contrat.Text = "" Then
MsgBox "Vous devez entrer le type de contrat...!!"
Me.Contrat.SetFocus
Exit Sub
End If
'On teste la saisie du n° de VDI...
If Me.VDI.Text = "" Then
MsgBox "Vous devez entrer le n° de VDI...!!"
Me.VDI.SetFocus
Exit Sub
End If
'On teste la saisie du n° de MA...
If Me.MA.Text = "" Then
MsgBox "Vous devez entrer le n° de MA...!!"
Me.MA.SetFocus
Exit Sub

End If

' Conversion du nom et prénom en NOMPRPRE
Nom = Application.WorksheetFunction.Proper(Me.Nom.Text)
Prenom = Application.WorksheetFunction.Proper(Me.Prenom.Text)
' Mise en place des valeurs saisies
Range("A65536").End(xlUp).Offset(1, 0).Value = Nom
Range("B65536").End(xlUp).Offset(1, 0).Value = Prenom
Range("C65536").End(xlUp).Offset(1, 0).Value = Matricule
Range("D65536").End(xlUp).Offset(1, 0).Value = Fonction
Range("E65536").End(xlUp).Offset(1, 0).Value = Localisation
Range("F65536").End(xlUp).Offset(1, 0).Value = Immeuble
Range("G65536").End(xlUp).Offset(1, 0).Value = Etage
Range("H65536").End(xlUp).Offset(1, 0).Value = Bureau
Range("I65536").End(xlUp).Offset(1, 0).Value = Contrat
Range("J65536").End(xlUp).Offset(1, 0).Value = Fcontrat
Range("K65536").End(xlUp).Offset(1, 0).Value = Motifcontrat
Range("L65536").End(xlUp).Offset(1, 0).Value = Application1
Range("M65536").End(xlUp).Offset(1, 0).Value = Etat1
Range("N65536").End(xlUp).Offset(1, 0).Value = Profil1
Range("O65536").End(xlUp).Offset(1, 0).Value = Application2
Range("P65536").End(xlUp).Offset(1, 0).Value = Etat2
Range("Q65536").End(xlUp).Offset(1, 0).Value = Profil2
Range("R65536").End(xlUp).Offset(1, 0).Value = Application3
Range("S65536").End(xlUp).Offset(1, 0).Value = Etat3
Range("T65536").End(xlUp).Offset(1, 0).Value = Profil3
Range("U65536").End(xlUp).Offset(1, 0).Value = Application4
Range("V65536").End(xlUp).Offset(1, 0).Value = Etat4
Range("W65536").End(xlUp).Offset(1, 0).Value = Profil4
Range("X65536").End(xlUp).Offset(1, 0).Value = Application5
Range("Y65536").End(xlUp).Offset(1, 0).Value = Etat5
Range("Z65536").End(xlUp).Offset(1, 0).Value = Profil5
Range("AA65536").End(xlUp).Offset(1, 0).Value = Application6
Range("AB65536").End(xlUp).Offset(1, 0).Value = Etat6
Range("AC65536").End(xlUp).Offset(1, 0).Value = Profil6
Range("AD65536").End(xlUp).Offset(1, 0).Value = Application7
Range("AE65536").End(xlUp).Offset(1, 0).Value = Etat7
Range("AF65536").End(xlUp).Offset(1, 0).Value = Profil7
Range("AG65536").End(xlUp).Offset(1, 0).Value = Application8
Range("AH65536").End(xlUp).Offset(1, 0).Value = Etat8
Range("AI65536").End(xlUp).Offset(1, 0).Value = Profil8
Range("AJ65536").End(xlUp).Offset(1, 0).Value = Application9
Range("AK65536").End(xlUp).Offset(1, 0).Value = Etat9
Range("AL65536").End(xlUp).Offset(1, 0).Value = Profil9
Range("AM65536").End(xlUp).Offset(1, 0).Value = VDI
Range("AN65536").End(xlUp).Offset(1, 0).Value = Informatique1
Range("AO65536").End(xlUp).Offset(1, 0).Value = Accès1
Range("AP65536").End(xlUp).Offset(1, 0).Value = Informatique2
Range("AQ65536").End(xlUp).Offset(1, 0).Value = Accès2
Range("AR65536").End(xlUp).Offset(1, 0).Value = Informatique3
Range("AS65536").End(xlUp).Offset(1, 0).Value = Accès3
Range("AT65536").End(xlUp).Offset(1, 0).Value = MA
Range("AU65536").End(xlUp).Offset(1, 0).Value = PDT1
Range("AV65536").End(xlUp).Offset(1, 0).Value = Accès4
Range("AW65536").End(xlUp).Offset(1, 0).Value = PDT2
Range("AX65536").End(xlUp).Offset(1, 0).Value = Accès5
Range("AY65536").End(xlUp).Offset(1, 0).Value = PDT3
Range("AZ65536").End(xlUp).Offset(1, 0).Value = Accès6
Range("BA65536").End(xlUp).Offset(1, 0).Value = CheckBox1
Range("BB65536").End(xlUp).Offset(1, 0).Value = CheckBox2
Range("BC65536").End(xlUp).Offset(1, 0).Value = CheckBox3
Range("BD65536").End(xlUp).Offset(1, 0).Value = CheckBox4
Range("BE65536").End(xlUp).Offset(1, 0).Value = CheckBox5
Range("BF65536").End(xlUp).Offset(1, 0).Value = CheckBox6
Range("BG65536").End(xlUp).Offset(1, 0).Value = CheckBox7
Range("BH65536").End(xlUp).Offset(1, 0).Value = CheckBox8
Range("BI65536").End(xlUp).Offset(1, 0).Value = CheckBox9
Range("BJ65536").End(xlUp).Offset(1, 0).Value = CheckBox10
Range("BK65536").End(xlUp).Offset(1, 0).Value = CheckBox11
Range("BL65536").End(xlUp).Offset(1, 0).Value = CheckBox12
Range("BM65536").End(xlUp).Offset(1, 0).Value = CheckBox13
Range("BN65536").End(xlUp).Offset(1, 0).Value = CheckBox14
Range("BO65536").End(xlUp).Offset(1, 0).Value = CheckBox15
Range("BP65536").End(xlUp).Offset(1, 0).Value = CheckBox16
Range("BQ65536").End(xlUp).Offset(1, 0).Value = CheckBox17
Range("BR65536").End(xlUp).Offset(1, 0).Value = CheckBox18
Range("BS65536").End(xlUp).Offset(1, 0).Value = CheckBox19
Range("BT65536").End(xlUp).Offset(1, 0).Value = CheckBox20
Range("BU65536").End(xlUp).Offset(1, 0).Value = CheckBox21
Range("BV65536").End(xlUp).Offset(1, 0).Value = CheckBox22
Range("BW65536").End(xlUp).Offset(1, 0).Value = CheckBox23
Range("BX65536").End(xlUp).Offset(1, 0).Value = CheckBox24
Range("BY65536").End(xlUp).Offset(1, 0).Value = CheckBox25
End Sub

Dim derlign As Long

derlign = Sheets("Listes").Range("f65536").End(xlUp).Row

cherch = Application4

Set cell = Sheets("Liste2").Range("f1:f" & derlign).Find(cherch, lookAt:=xlWhole)
If Not cell Is Nothing Then

Etat4.Value = cell.Offset(0, 1)
Entité4.Value = cell.Offset(0, 3)
Service4.Value = cell.Offset(0, 2)


End If

End Sub
 

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 812
dernier inscrit
abdouami