Userform résultats formules retournées automatiquement dans le formulaire
j'ai reduit l'USF par le bas, je n'avais pas de possibilité depuis le haut.
Donc on voit la partie haute de l'USF
Ok mais quelle est alors la dimension de l'USF ?dans ce cas
Elle est de 505,5
et elle est comme sur l'image précédente.
Oups désolé je viens de voir que vous me l'aviez dit
1. Initialize : remplacez le code par celui ci-dessous
Private Sub UserForm_Initialize()
txtDate.Value = Format(Now, "DD/MM/YYYY")
With Feuil3
cboTypeMarche.List = .ListObjects("TTypeMarche").DataBodyRange.Value
cboChargeMission.List = .ListObjects("TChargeMisssion").DataBodyRange.Value
cboProcedure.List = .ListObjects("TProcedure").DataBodyRange.Value
cboCodeNCMP.List = .ListObjects("TCodeNCMP").ListColumns(1).DataBodyRange.Value
cboMode.List = .ListObjects("Tmode").DataBodyRange.Value
cboNaturePrix.List = .ListObjects("Tprix").DataBodyRange.Value
cboCloture.List = .ListObjects("TCloture").DataBodyRange.Value
End With
With ListBox1
.ColumnCount = 8
.ColumnWidths = "50;50;20;80;20;50;70;100"
End With
With ListBox2 'titres de la listbox1
.ColumnCount = 8
.ColumnWidths = "50;50;20;80;20;50;70;100"
.AddItem "Date"
.List(0, 1) = "Année"
.List(0, 2) = "N°"
.List(0, 3) = "N° Marché"
.List(0, 4) = "Lot"
.List(0, 5) = "N° Lot"
.List(0, 6) = "Type Marché"
.List(0, 7) = "Chargé mission"
End With
'Me.ScrollBars = fmScrollBarsVertical
'Me.ScrollHeight = 850
Me.Height = 505 'dimensionner USF
End Sub2. Bouton rechercher
Private Sub btnRechercher_Click()
Me.Height = 650
TextBox2.SetFocus
End SubDites-moi si ok à l'ouverture et en cliquant sur le bouton rechercher
NB : La listbox2 est au-dessus de la listbox1 et reprend les titres tandis que la listbox 1 est prévue pour afficher les infos de la feuille Source
Super ! Le USF apparait à l'ouverture comme l'image envoyée précédemment.
Quand je clique sur le bouton "Rechercher" les éléments du bas apparait avec le zone insertion de texte, la zone pour les titres des champs et la zone pour les résultats de la recherche.
Pour le moment rien ne se passe quand j'inscrit des choses dans la zone de recherche.
Pour le moment rien ne se passe quand j'inscrit des choses dans la zone de recherche.
Oui normal. Ajoutez les deux codes ci-dessous
1. Textbox2 - N° de marché recherché
Private Sub TextBox2_Change() 'recherche du N° marché
Dim prem
Dim i As Byte
Dim c As Range
Me.ListBox1.Clear
If Me.TextBox2 <> "" Then
With Feuil1
.ListObjects(1).ListColumns(4).DataBodyRange.Select
Set c = .ListObjects(1).ListColumns(4).Range.Find("*" & Me.TextBox2.Value & "*", LookIn:=xlValues)
If Not c Is Nothing Then
prem = c.Address
i = 0
Do
Me.ListBox1.AddItem
Me.ListBox1.List(i, 0) = c.Offset(0, -3).Value 'date
Me.ListBox1.List(i, 1) = c.Offset(0, -2).Value 'annee
Me.ListBox1.List(i, 2) = c.Offset(0, -1).Value 'n°
Me.ListBox1.List(i, 3) = c.Offset(0, 0).Value 'N° marche
Me.ListBox1.List(i, 4) = c.Offset(0, 1).Value 'lot
Me.ListBox1.List(i, 5) = c.Offset(0, 2).Value 'N°lotType lot
Me.ListBox1.List(i, 6) = c.Offset(0, 3).Value 'Type lot
Me.ListBox1.List(i, 7) = c.Offset(0, 4).Value 'charge mission
Set c = .ListObjects(1).ListColumns(4).Range.FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> prem
End If
End With
End If
Set c = Nothing
End Sub2. Affichage des données en Listbox1 selon info textbox2
Private Sub ListBox1_Click()
Dim ctrl As Control
Dim lg As Integer
stpevt = True
'effacer les données
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "TextBox"
If UCase(ctrl.Name) <> "TXTDATE" And UCase(ctrl.Name) <> "TEXTBOX2" Then ctrl.Value = vbNullString
Case "Listbox", "ComboBox"
If UCase(ctrl.Name) <> "LISTBOX1" And UCase(ctrl.Name) <> "LISTBOX2" Then
ctrl.Value = ""
ctrl.ListIndex = -1
End If
End Select
Next ctrl
lg = ListBox1.ListIndex + 1
With Feuil1.ListObjects(1).DataBodyRange
txtAnnee = .Item(lg, 2)
txtNumero = .Item(lg, 3)
txtNumeroMarche = .Item(lg, 4)
txtLot = .Item(lg, 5)
txtNumeroLot = .Item(lg, 6)
cboTypeMarche.Value = .Item(lg, 7)
cboChargeMission.Value = .Item(lg, 8)
cboProcedure.Value = .Item(lg, 9)
txtObjet.Value = .Item(lg, 11)
txtAttributaire.Value = .Item(lg, 13)
txtSiret.Value = .Item(lg, 14)
txtlanceProcedure.Value = .Item(lg, 15)
txtDateRemisePli.Value = .Item(lg, 16)
txtNotifi.Value = .Item(lg, 17)
cboNaturePrix.Value = .Item(lg, 19)
txtEstimaBeoins.Value = .Item(lg, 20)
txtMontantHT.Value = .Item(lg, 21)
txtDataAvisCGEFI.Value = .Item(lg, 23)
txtDateCAO.Value = .Item(lg, 24)
txtNotifAR.Value = .Item(lg, 25)
txtDateAvisAttrib.Value = .Item(lg, 26)
cboCloture.Value = .Item(lg, 28)
End With
stpevt = False
End SubIl vous suffit d'entrer le N° de marché dans la textbox2 pour avoir la liste des données dans la listbox
En sélectionnant une ligne dans la listbox, les données de la ligne seront rapatriées dans les textbox et combobox de l'userform.
Si vous supprimez la donnée dans la textbox2, la listbox est vidée des infos
Cordialement
Rem : Voyez aussi mon message en MP qui ne concerne pas le fichier
Ces derniers codes, je les place ou ? à la fin de l'ensemble des codes déjà inscrits ? Faut-il cliquer sur le bouton "Rechercher" avant d'insérer ?
J'ai collé les codes à la suite du code
et j'ai une erreur
Re
C'est que vous l'avez deux fois dans l'USF
et je dois faire comment ?
J'ai effacer une, l'USF s'affiche, mais quand j'inscris quelque chose dans la zone de recherche j'ai une erreur
et je dois faire comment ?
Vous avez deux fois la sub Private Listbox1_click. Supprimez l'autre et conservez celui que je viens de vous donner.
J'ai effacer une, l'USF s'affiche, mais quand j'inscris quelque chose dans la zone de recherche j'ai une erreur
c'était un test. Supprimez la ligne
J'ai beau cherché mais je ne trouve pas une deuxième sub Private Listbox1_click
L'ensemble de mon code est le suivant :
Dim lig As Integer
Dim stpevt As Boolean
Private Sub btnAjout_Click()
With Feuil1.ListObjects(1)
With .DataBodyRange
.Item(lig, 7) = cboTypeMarche.Value
.Item(lig, 8) = cboChargeMission.Value
.Item(lig, 9) = cboProcedure.Value
.Item(lig, 11) = txtObjet.Value
.Item(lig, 13) = txtAttributaire.Value
.Item(lig, 14) = txtSiret.Value
.Item(lig, 15) = txtlanceProcedure.Value
.Item(lig, 16) = txtDateRemisePli.Value
.Item(lig, 17) = txtNotifi.Value
.Item(lig, 19) = cboNaturePrix.Value
.Item(lig, 20) = txtEstimaBeoins.Value
.Item(lig, 21) = txtMontantHT.Value
.Item(lig, 23) = txtDataAvisCGEFI.Value
.Item(lig, 24) = txtDateCAO.Value
.Item(lig, 25) = txtNotifAR.Value
.Item(lig, 26) = txtDateAvisAttrib.Value
.Item(lig, 28) = cboCloture.Value
End With
End Sub
Private Sub btnFer()
Private Sub btnFermer_Click()
Unload Me
End Sub
Private Sub btnTableauSource_Click()
Call btnFermer_Click
Feuil1.Activate
End Sub
Private Sub CommandButton1_Click()
Me.Height = 650
TextBox2.SetFocus
End Sub
Private Sub DateAvisCGEFI_Click()
End Sub
Private Sub txtLot_Change()
If stpevt = True Then Exit Sub
With Feuil1.ListObjects(1)
If txtLot = vbNullString Then
txtAnnee = vbNullString
txtNumero = vbNullString
txtNumeroLot = vbNullString
txtNumeroMarche = vbNullString
Exit Sub
End If
If .ListRows.Count = 0 Then
.ListRows.Add: lig = 1
Else: .ListRows.Add: lig = .ListRows.Count
End If
With .DataBodyRange
.Item(lig, 1) = Format(CDate(txtDate.Value), "mm/dd/yyyy")
If txtLot > 0 Then .Item(lig, 5) = txtLot.Value
txtAnnee.Value = .Item(lig, 2).Value
txtNumero = .Item(lig, 3).Value
txtNumeroMarche = .Item(lig, 4).Value
txtNumeroLot = .Item(lig, 6).Value
End With
Call Verification
End With
End Sub
Private Sub UserForm_Initialize()
txtDate.Value = Format(Now, "DD/MM/YYYY")
With Feuil3
cboTypeMarche.List = .ListObjects("TTypeMarche").DataBodyRange.Value
cboChargeMission.List = .ListObjects("TChargeMisssion").DataBodyRange.Value
cboProcedure.List = .ListObjects("TProcedure").DataBodyRange.Value
cboCodeNCMP.List = .ListObjects("TCodeNCMP").ListColumns(1).DataBodyRange.Value
cboMode.List = .ListObjects("Tmode").DataBodyRange.Value
cboNaturePrix.List = .ListObjects("Tprix").DataBodyRange.Value
cboCloture.List = .ListObjects("TCloture").DataBodyRange.Value
End With
With ListBox1
.ColumnCount = 8
.ColumnWidths = "50;50;20;80;20;50;70;100"
End With
With ListBox2 'titres de la listbox1
.ColumnCount = 8
.ColumnWidths = "50;50;20;80;20;50;70;100"
.AddItem "Date"
.List(0, 1) = "Année"
.List(0, 2) = "N°"
.List(0, 3) = "N° Marché"
.List(0, 4) = "Lot"
.List(0, 5) = "N° Lot"
.List(0, 6) = "Type Marché"
.List(0, 7) = "Chargé mission"
End With
'Me.ScrollBars = fmScrollBarsVertical
'Me.ScrollHeight = 850
Me.Height = 505 'dimensionner USF
End Sub
Private Sub Verification() 'vérifier si pas deux fois le même lot pour le même numéro de marche
Dim c As Range
Dim i As Byte
With Feuil1.ListObjects(1)
Set c = .ListColumns(5).DataBodyRange.Find(txtLot, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
If c.Offset(0, -1).Value = txtNumeroMarche And c.Value = CDbl(txtLot) Then i = i + 1
If i = 2 Then
MsgBox "Ce lot existe déjà pour le numéro de marché " & txtNumeroMarche, vbCritical, "Doublon de lot"
.ListRows(lig).Delete
txtLot = vbNullString
Exit Do
End If
Set c = .ListColumns(5).DataBodyRange.FindNext(c)
Loop While Not c Is Nothing And firstaddress <> c.Address
End If
End With
End Sub
Private Sub btnEffacer_Click()
Dim ctrl As Control
stpevt = True
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "TextBox"
If UCase(ctrl.Name) <> "TXTDATE" Then ctrl.Value = vbNullString
Case "Listbox", "ComboBox"
ctrl.Value = ""
ctrl.ListIndex = -1
End Select
Next ctrl
stpevt = False
End Sub
Private Sub TextBox2_Change() 'recherche du N° marché
Dim prem
Dim i As Byte
Dim c As Range
Me.ListBox1.Clear
If Me.TextBox2 <> "" Then
With Feuil1
.ListObjects(1).ListColumns(4).DataBodyRange.Select
Set c = .ListObjects(1).ListColumns(4).Range.Find("*" & Me.TextBox2.Value & "*", LookIn:=xlValues)
If Not c Is Nothing Then
prem = c.Address
i = 0
Do
Me.ListBox1.AddItem
Me.ListBox1.List(i, 0) = c.Offset(0, -3).Value 'date
Me.ListBox1.List(i, 1) = c.Offset(0, -2).Value 'annee
Me.ListBox1.List(i, 2) = c.Offset(0, -1).Value 'n°
Me.ListBox1.List(i, 3) = c.Offset(0, 0).Value 'N° marche
Me.ListBox1.List(i, 4) = c.Offset(0, 1).Value 'lot
Me.ListBox1.List(i, 5) = c.Offset(0, 2).Value 'N°lotType lot
Me.ListBox1.List(i, 6) = c.Offset(0, 3).Value 'Type lot
Me.ListBox1.List(i, 7) = c.Offset(0, 4).Value 'charge mission
Set c = .ListObjects(1).ListColumns(4).Range.FindNext(c)
i = i + 1
Loop While Not c Is Nothing And c.Address <> prem
End If
End With
End If
Set c = Nothing
End Sub
Private Sub ListBox1_Click()
Dim ctrl As Control
Dim lg As Integer
stpevt = True
'effacer les données
For Each ctrl In Me.Controls
Select Case TypeName(ctrl)
Case "TextBox"
If UCase(ctrl.Name) <> "TXTDATE" And UCase(ctrl.Name) <> "TEXTBOX2" Then ctrl.Value = vbNullString
Case "Listbox", "ComboBox"
If UCase(ctrl.Name) <> "LISTBOX1" And UCase(ctrl.Name) <> "LISTBOX2" Then
ctrl.Value = ""
ctrl.ListIndex = -1
End If
End Select
Next ctrl
lg = ListBox1.ListIndex + 1
With Feuil1.ListObjects(1).DataBodyRange
txtAnnee = .Item(lg, 2)
txtNumero = .Item(lg, 3)
txtNumeroMarche = .Item(lg, 4)
txtLot = .Item(lg, 5)
txtNumeroLot = .Item(lg, 6)
cboTypeMarche.Value = .Item(lg, 7)
cboChargeMission.Value = .Item(lg, 8)
cboProcedure.Value = .Item(lg, 9)
txtObjet.Value = .Item(lg, 11)
txtAttributaire.Value = .Item(lg, 13)
txtSiret.Value = .Item(lg, 14)
txtlanceProcedure.Value = .Item(lg, 15)
txtDateRemisePli.Value = .Item(lg, 16)
txtNotifi.Value = .Item(lg, 17)
cboNaturePrix.Value = .Item(lg, 19)
txtEstimaBeoins.Value = .Item(lg, 20)
txtMontantHT.Value = .Item(lg, 21)
txtDataAvisCGEFI.Value = .Item(lg, 23)
txtDateCAO.Value = .Item(lg, 24)
txtNotifAR.Value = .Item(lg, 25)
txtDateAvisAttrib.Value = .Item(lg, 26)
cboCloture.Value = .Item(lg, 28)
End With
stpevt = False
End Sub1. Vérifiez si vous n'avez pas deux listbox1 sur votre userform.
2. dans Textbox2 change, vous avez toujours la ligne que je vous ai dit de supprimer
Bonjour,
j'ai supprimer la ligne et ça fonctionne !!! J peux inserrer des dates dates et la liste apparait en bas.
Cependant, si je renseigne les champs suivants, le bouton "Ajout dans la base" n'est pas fonctionnel (toujours grisé). Par ailleurs, suite à une recherche, quand je clique sur une des lignes des résultats, l'interface n'affiche pas la date d'enregistrement de cette ligne, mais cela affiche la date du jour.
Bonjour
Cependant, si je renseigne les champs suivants, le bouton "Ajout dans la base" n'est pas fonctionnel (toujours grisé).
Il faut connaitre le critère qui permet de rendre actif le bouton. On peut faire en sorte qu'une fois les colonnes A à F sont complétées, le bouton devient actif.
De base il faut définir un critère à partir duquel le bouton est rendu actif. Par exemple si on a un Type de marché ou chargé de mission ?
Il faut garder en mémoire que c'est le code textbox2_change qui complète toujours les colonnes A à F et donc qu'à ce moment là, le bouton ajout doit rester inactif.
Par ailleurs, suite à une recherche, quand je clique sur une des lignes des résultats, l'interface n'affiche pas la date d'enregistrement de cette ligne, mais cela affiche la date du jour.
Assez simple à priori, dans le code Private Sub ListBox1_Click(), rajoutez cette ligne juste en dessous de With Feuil1.ListObjects(1).DataBodyRange
txtDate = .Item(lig, 1)Bonjour Dan,
Oui je pense que le critère pour le bouton "Ajout dans la base" peut être activé dès que le Type de Marché est renseigné.
J'ai bien ajouté le dernier code et quand je fais une recherche et que je clique sur une ligne des résultats de la recherche, c'est le mot "Date" qui s'affiche dans le champ et non la vraie date renseignée dans l'enregistrement. Voir tableau ci-dessous:
Par ailleurs est-ce que le critère de recherche peut être fait sur le champ "Chargé de mission" ?
Bonjour
Oui je pense que le critère pour le bouton "Ajout dans la base" peut être activé dès que le Type de Marché est renseigné.
Je ne pense pas car si txtlot n'est pas complétée on peut toujours faire un choix dans cette combo.
Actuellement je pense que le mieux serait de l'activer si la textbox txtlot contient une donnée.
J'ai bien ajouté le dernier code et quand je fais une recherche et que je clique sur une ligne des résultats de la recherche, c'est le mot "Date" qui s'affiche dans le champ et non la vraie date renseignée dans l'enregistrement. Voir tableau ci-dessous:
Non, pas dans le fichier que vous avez posté ici et qui me sert de fichier de travail.
Le titres de votre tableau sont bien sur la ligne 1 ?
Par ailleurs est-ce que le critère de recherche peut être fait sur le champ "Chargé de mission" ?
Non vous m'aviez dit sur le champ numéro de marché si je me souviens.
On peut faire aussi avec le chargé de mission mais dans ce cas le mieux serait de rajouter une autre textbox pour le chargé de mission.
La recherche se ferait soit sur le numéro de marché soit sur la chargé de mission
Si vous voulez vraiment une seule textbox, je peux regarder
ok, d'accord avec votre remarque, on va activé le bouton "Ajouter" si txtlot contient une donnée.
Dans mon fichier, les titres du tableaus ont bien sur la ligne 1 :
Effectivement j'aurais préféré votre dernière remarque avec "La recherche se ferait soit sur le numéro de marché soit sur la chargé de mission".
Par contre je ne vois pas ou et comment ajouter une autre textbox ? Pourriez-vous me faire une petite copie d'"écran pour voir ou et comment serait cette textbox ?
ok, d'accord avec votre remarque, on va activé le bouton "Ajouter" si txtlot contient une donnée.
Alors modifiez comme ceci dans la Private Sub txtLot_Change(),
1. au début du code juste avant le EXIT SUB, ajoutez cette ligne
btnAjout.Enabled = False2. Au dessus du CALL verification, vous verrez un END WITH. Ajoutez cette ligne juste au dessus du END WITH
btnAjout.Enabled = TrueEffectivement j'aurais préféré votre dernière remarque avec "La recherche se ferait soit sur le numéro de marché soit sur la chargé de mission".
Par contre je ne vois pas ou et comment ajouter une autre textbox ? Pourriez-vous me faire une petite copie d'"écran pour voir ou et comment serait cette textbox ?
On va tester avec une seule textbox. Le seul souci que j'ai actuellement est le tiret que vous avez mis après l'année.
Sinon il aurait suffit d'ajouter la nouvelle textbox à coté de l'autre dans la zone recherche