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