XL 2019 Saisie Formulaire par ComboBox, mais pas que !

[Choco2x]

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 !

 

[Choco2x]

Ben non... Tant que c'est pas en plein milieu, moi ça ne me dérange pas. D'où ma demande à un collègue qui m'a dit savoir comment faire. Je suis désolé que tu penses çà.

 

[Choco2x]

Il avait mis des " ' " pour le cacher, d'après ce que j'ai vu après ton alerte... Il ne l'avait pas supprimé, même si c'est pas mieux...

 

[JM27]

Ben tu demanderas à ton collègue ; il n'a pas fait que cela

 

[Choco2x]

Je t'avais pourtant dis de ne pas supprimer l'auteur , tu vas au devant de beaucoup de pb. ( je ne te préciserait pas ce qui peut arriver)
Ca ne m'incite pas à poursuivre
en plus c'est vraiment pas sympas

Tu pourras appeler le service concerné dans un mois, tu verras que la signature y sera toujours


Quoi d'autre ? Qui touche à l'identification de l'auteur ?
J'ai touché aux fonctionnalités du fichier, dont j'ai besoin rapidement, pas de temps à perdre avec autre chose...
Le logo en fond de formulaire ? C'est moi qui l'ai mis, je me disais que ça n'enlèverait rien à ton crédit...
Je retire les deux précédents fichiers, pour que les infos s'y trouvant encore ne se promènent pas.
N'hésite pas à me contacter si tu veux d'autres détails.

 

[Choco2x]

Je n'ai même pas testé cette version de sauvegarde depuis qu'il y a touché, donc je ne sais pas et ça n'était pas le but.
Bon ben je te comprends que tu laisses tomber, pas de soucis.
Je t'assures juste que je suis de bonne foi.

Merci encore, quoi qu'il en soit, et je suis très sincèrement désolé pour cette histoire.

 

[Choco2x]

Bonjour !
Bon ben suite à ce malentendu, je mets quand même à dispo le fichier le plus abouti que j'aie en ma possession, en ayant enlevé les données personnelles (j'espère n'avoir rien oublié), pour la communauté.

J'ai également remis la présentation initiale de mon 1er post, à la demande des futures utilisatrices, mais le codage reste celui de JM27. Son crédit a été repositionné en bas du formulaire plutôt qu'au milieu, comme je l'avais demandé initialement à mon collègue, tout simplement.

JM27 > si j'avais vraiment été si fourbe, j'aurais au moins remis ton crédit pour que tu ne voies pas la manoeuvre avant de poster les derniers fichiers, ne penses-tu pas ?
Mais je te comprends, ta colère est légitime après le temps passé dessus et ton envie de rendre service, tu as dû te sentir trahi.
J'ai seulement dû l'adapter un peu à mes goûts et à mes besoins spécifiques, mais si le fichier ci-joint te dérange, dis-le-moi, je l'enlèverai, je ne cherche ni à nuire ni à contrarier qui que ce soit.
Merci encore et désolé, une dernière fois.