XL 2019 Saisie Formulaire par ComboBox, mais pas que !

Choco2x

XLDnaute Occasionnel
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 !
 

JM27

XLDnaute Barbatruc
Effectivement
J'avais oublié
la boite dialogue des dates est tributaire des positions des objets et notamment des frame

regarde de ce coté la
et supprimes + FrameTransport.Left

Code:
' programme d 'affichafe de la boite de dialogue date
Private Sub TxtDateDuTransport_Enter()
      ' posiionnement haut de la boite de dialogue
     MemTop = Me.Top + TxtDateDuTransport.Top + TxtDateDuTransport.Height
      ' posiionnement gauche de la boite de dialogue
     MemLeft = Me.Left + FrameTransport.Left + TxtDateDuTransport.Left + Me.TxtDateDuTransport.Width
     ' je lui induique ou il doit retouner la valeur
     Set Toto = UserFormTransport.TxtDateDuTransport
     PicDateXLD.Show
End Sub
 

Choco2x

XLDnaute Occasionnel
Je l'avais fait, mais ça bugguait quand même, c'est pour çà que je suis reparti d'une version sauvegardée...
J'ai recommencé ma présentation, ça fonctionne, si ce n'est que le tri a du mal à se faire dans les services. Il laisse des blancs, et si je veux monter les données de ligne manuellement, il me dit que les cellules contiennent des données. Y a-t-il quelque chose à cet endroit ?
 

JM27

XLDnaute Barbatruc
A tout les coups tu as des espaces dans les cellules en ligne 4 (service)
j'ai vu cela sur ton fichier
d'où l'importance de ne pas bidouiller manuellement dans les feuilles , (dès que cela marche)
Utiliser impérativement l'userform (info à passer aux infirmières)
 
Dernière édition:

JM27

XLDnaute Barbatruc
????
si tu entres un espace ( sans rien d'autre) dans la saisie via l'userform service par exemple , tu auras un défaut , la validation se fera , la cellule de destination aura un espace et dans feuille de travail dans les items du service
 

Choco2x

XLDnaute Occasionnel
J'ai l'impression que quand je valide une fiche sans remplir les champs services et etablissements, il met un "^" à la place, et prend donc les premières lignes du tableau, après tri... Qu'est-ce que c'est que ce "^" ?!?...
j'ai çà à présent devant tout ce que je met, même manuellement, même dans d'autres fichiers...
 

Choco2x

XLDnaute Occasionnel
J'ai remis le "forçage" sur le remplissage des champs concernés, et ça fonctionne... Je vais laisser comme çà, je pense... Mais c'est dommage, ils ne savent pas toujours le service de destination au moment de la commande, je vais sûrement mettre un " Inconnu" en première ligne de proposition...
 

JM27

XLDnaute Barbatruc
j'ai retrouvé des bugs ,
Dans les deux macro de tri
TriService
TriEtablissement

il faut trier à partir de la ligne 2

.Sort.SetRange Range("D2:D" & LigneDeTri)

postes ton fichier modifié j'ai repéré d'autres erreurs

pour le service de destination : Non dans la propriété TAG de ComboServiceDestination
 

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG