XL 2013 Combobox en cascade

[exceladdict]

Bonjour,
j'essaye de créer un programme en vba qui alimente un Userform à partir de 2 feuilles différentes(donc 2 tableaux différents) au moyen de 2 combobox. Le premier combobox sert à sélectionner l'adresse d'un médecin ou d'un établissement de santé le second à récupérer les barèmes de prise en charge sécurité sociale et mutuelle en fonction de l'acte ou de la spécialité. Le principe est de rechercher via la liste du combobox1 le nom du praticien et une fois trouvé sélectionner à partir du combobox 2 un acte ou une spécialité associée.
Le premier step se déroule très bien mais lorsque je veux accéder aux données de la seconde base ("Remb") il ne se passe rien. Je n'ai pas d'erreur mais je n'obtiens pas les données correspondantes.
J'ai essayé des corrections avec des conseils glanés sur divers forums mais rien n'y fait je reste bloqué…
D'où ma démarche ici...aide bienvenue Merci
Ci-Joint contenu de l'userform et fichier *.xlsm

Private Sub ComboBox1_Change()
ComboBox1.Value = UCase(ComboBox1.Value)

Dim nom As String, adr As String, plage As Range, recherche As Range
With Sheets("Base")
Set plage = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
nom = ComboBox1.Value
If nom = "" Then Exit Sub



Set recherche = plage.Find(nom, , xlValues, xlWhole)
If Not recherche Is Nothing Then
adr = recherche.Address

With recherche

ComboBox1.Value = .Value 'nom du med pointé par adr
ComboBox2.Value = .Offset(0, 9).Value
TextBox11.Value = .Value
TextBox12.Value = .Offset(0, 1).Value
TextBox13.Value = .Offset(0, 2).Value
TextBox14.Value = .Offset(0, 3).Value
TextBox15.Value = .Offset(0, 4).Value
TextBox16.Value = .Offset(0, 5).Value
TextBox17.Value = .Offset(0, 6).Value
TextBox18.Value = .Offset(0, 7).Value
TextBox22.Value = .Offset(0, 8).Value

End With
Else
MsgBox ("Données Inexistantes création de fiche obligatoire ")
UserForm4.Show
End If

End Sub

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsNull(ComboBox1.Value) Or ComboBox1.Value = "" Then MsgBox "Le Champ Nom ne peut pas être vide"
End Sub


Private Sub ComboBox2_change()
Dim nblig As Long
nblig = Range("B" & Rows.Count).End(xlUp).Row
ComboBox2.Value = UCase(ComboBox2.Value)
'------------------------------------------------------------------------------------
With Sheets("Remb")
nblig = .Range("B" & Rows.Count).End(xlUp).Row
End With

With Me.ComboBox2
.List = Sheets("Remb").Range("B2:B" & nblig).Value
'.ListIndex = .ListCount - 1 '
End With

'--------------------------------------------------------------------------------------


Dim codess As String, adrx As String, xplage As Range, rech As Range


With Sheets("Remb")
Set xplage = .Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
End With
codess = Left(ComboBox2.Value, 2)
MsgBox (codess)
If codess = "" Then Exit Sub

Set rech = xplage.Find(codess, , xlValues, xlWhole)
If Not rech Is Nothing Then
adrx = rech.Address
MsgBox (adrx)
Do
With rech

ComboBox2.Value = .Value ' codification secu pointé par adrx
TextBox7.Value = Format(.Offset(0, 1).Value, "0.00") 'base du remboursement sécu
TextBox5.Value = Format(.Offset(0, 2).Value, "0.00") ' Ticket Modérateur
TextBox6.Value = Format(.Offset(0, 3).Value, "0.00") 'BRSS sécu
TextBox4.Value = Format(.Offset(0, 4).Value, "0.00") 'FRanchise
TextBox8.Value = Format(.Offset(0, 2).Value, "0.00") 'TM Mut
TextBox9.Value = Format(.Offset(0, 6).Value, "0.00") '%BRSS Mut
TextBox10.Value = Format(.Offset(0, 7).Value, "0.00") 'Plafond ou forfait

End With

Loop While Not rech Is Nothing And recherche.Address <> adrx
Else

End If

End Sub

Private Sub CommandButton2_Click()

' paraméter ici les champs à sauvegarder dans la base livre

Unload Me


End Sub
Private Sub CommandButton3_Click()
'effacement des donnéees du formulaire sans le décharger
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "TextBox"
c.Value = ""
Case "CheckBox"
c.Value = False
Case "ListBox", "ComboBox"
c.ListIndex = -1
End Select
Next c
End Sub
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
'ouverture du cal avec date du jour
Me.DTPicker1.Value = Date
End Sub

Private Sub UserForm_Initialize()

Dim plage As Long
plage = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row + 1
'on limite l'affichage de la liste du combobox aux seuls enregistrements présents
' et on évite le recours à la propriété row

With Me.ComboBox1
.List = Sheets("Base").Range("A2:A" & plage).Value
'.ListIndex = .ListCount - 1
End With

End Sub

 

[exceladdict]

Top ! ton dernier code fait exactement ça ..... et effectivement le préfixe n'est pas vraiment utile. C'était à la base pour ne pas mélanger les définitions qui sont trés proches... mais bon ! Je vais maintenant l'étudier de près déja pour l'adapter précisemment et pour m'en servir en d'autres circonstances. Vraiment un grand merci... l'entraide est vraiment la clef de beaucoup de choses ! Dernière point je n'ai pas bien creusé le dernier step du projet pour la création d'onglet automatique en fonction du nom tu aurais une piste de code ?
A plus et encore merci Jean-Marie

 

[ChTi160]

Re
je regarde ce que je peux faire pour ce qui est de la création de feuille et donc vérifier si feuille existe pour transfert .
n'hésite pas si besoin!
jean marie