XL 2019 Saisie Formulaire par ComboBox, mais pas que !

Bonjour à toutes et à tous !


Je n’ai pas trouvé de solution à mes besoins en cherchant dans les sujets, je me permets donc de venir vers vous.

J’ai un formulaire qui doit remplir un tableau.

Sur une autre page (Feuille 3), j’ai une « base de données » composée de deux tableaux (1 et 2) à remplir à l’aide de ce formulaire.

De même, j’aimerais que mes combobox me permettent de voir ce qui a déjà été saisi, et que si je saisis un nouveau mot il entre de ce fait dans la base de données.

Pour le moment ça ne fonctionne que si je n’ai qu’un champ rempli, sur les 3 qui m’intéressent (deux champs ont un même tableau en commun).

Sachant qu’il y aura forcément des doublons, j’ai essayé d’intégrer une macro qui les efface. Et pour terminer j’aimerais que les tableaux de ma base de données soit en ordre alphabétique, afin de mieux profiter des menus déroulants en découlant.
Tout fonctionnait jusqu'à ce que j'essaye de remplir mes champs d'après les combobox, car avant j'utilisais des textbox, mais alors je ne pouvais pas voir si ce que j'allais taper était déjà dans la base de données ou pas...


Voici dont le résultat de mes galères depuis 15 jours…

Ne critiquez pas mes formules svp, je me débrouille comme je peux, j’ai utilisé un ensemble de formules trouvées sur internet et de macros recopiées…

Allez, c'est parti (je mets tout, pour ne pas passer à côté du problème !) :



Private Sub btnAjout_Click()


‘Quand je valide mon formulaire, il rempli un premier tableau journalier.

Feuil1.Activate

Range("A2:K2").Select

Selection.ListObject.ListRows.Add (1)

Range("A3:K3").Select

Selection.Copy

Range("A4").Select

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("A2").Select

Selection.Offset(1, 0).Select

ActiveCell = txtNom.Value

ActiveCell.Offset(0, 1).Value = txtPrénom

ActiveCell.Offset(0, 3).Value = txtDateNaiss

ActiveCell.Offset(0, 4).Value = txtDateTps

ActiveCell.Offset(0, 6).Value = cboHeureDép

ActiveCell.Offset(0, 7).Value = cboServiceDép

ActiveCell.Offset(0, 8).Value = cboHeureArr

ActiveCell.Offset(0, 9).Value = cboServiceArr

ActiveCell.Offset(0, 10).Value = cboMotif

ActiveCell.Offset(0, 11).Value = txtComment



If OptbtnMme.Value = True Then

Range("C3").Value = "Femme"

End If

If OptbtnM.Value = True Then

Range("C3").Value = "Homme"

End If



If OptbtnAmb.Value = True Then

Range("F3").Value = "Ambulance"

End If

If OptbtnVSL.Value = True Then

Range("F3").Value = "VSL"

End If





Feuil3.Activate

Range("A1").Select

Selection.End(xlDown).Select 'On se positionne sur la dernière ligne

Selection.Offset(1, 0).Select 'On se décale d'une ligne vers le bas

ActiveCell = Me.cboServiceArr.Value



‘********* CA NE FONCTIONNE QUE JUSQUE LA, si je valide ce qui suit ça ferme Excel !*************



Feuil3.Activate

Range("B1").Select

Selection.End(xlDown).Select 'On se positionne sur la dernière ligne

Selection.Offset(1, 0).Select 'On se décale d'une ligne vers le bas

ActiveCell = Me.cboMotif.Value



Feuil3.Activate

Range("B1").Select

Selection.End(xlDown).Select 'On se positionne sur la dernière ligne

Selection.Offset(1, 0).Select 'On se décale d'une ligne vers le bas

ActiveCell = Me.cboServiceDép.Value



'Trie les tableaux



Sheets("Base de données").Select

Range("Tableau1[Etablissements]").Select

ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau1").Sort. _

SortFields.Clear

ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau1").Sort. _

SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:= _

xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau1").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Range("Tableau2[Services]").Select

ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau2").Sort. _

SortFields.Clear

ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau2").Sort. _

SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:= _

xlAscending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Base de données").ListObjects("Tableau2").Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With



'***********************************************

'Enlève les doublons



Feuil3.Activate

Range("Tableau1[Etablissements]").Select

ActiveSheet.Range("Tableau1[Etablissements]").RemoveDuplicates Columns:=1, Header:= _

xlYes

Range("Tableau2[Services]").Select

ActiveSheet.Range("Tableau2[Services]").RemoveDuplicates Columns:=1, Header:= _

xlYes

Range("A6").Select



**************************la suite fonctionne*********************



OptbtnMme = ""

OptbtnM = ""

OptbtnAmb = ""

OptbtnVSL = ""

txtNom = ""

txtPrénom = ""

cboSexe = ""

txtDateNaiss = ""

txtDateTps = ""

CboModeTps = ""

cboHeureDép = ""

cboServiceDép = ""

cboHeureArr = ""

cboServiceArr = ""

cboMotif = ""

txtComment = ""



Sheets("Commandes").Select

Range("Tableau10[NOM]").Select



End Sub



‘*********************************et voilà !!*****************************





Mille remerciements par avance à qui pourra m’aider !