Bonjour à tous,
Quelqu'un pourrait-il me donner des pistes pour pouvoir ajouter dans une combobox de nouveaux enregistrements.
Ma combo marche mais elle se comporte pas normalement.
1 Elle affiche bien les enregistrements anciens, mais refuse les nouveaux.
2 Quand je fais défilé les enregistrements elle reste figé sur le dernier sélectionné.
Voici le code que j'utilise adapté de la commandbar de Raymond Seneque.
Merci de votre aide
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71 Option Compare Database Option Explicit Dim Db As DAO.Database Dim Rs As DAO.Recordset Dim StrEpiFabric As String Dim StrSQL As String Dim CB As CommandBar Dim CBBouton As CommandBarControl Dim CBSous_Menu As CommandBarControl Const Bt20 = "Sélection" Private Sub Form_Activate() On Error Resume Next CBBouton.Text = Me!EpiReference & ", " & Me!EpiFabric Select Case Me.CurrentRecord End Select End Sub Private Sub Form_AfterUpdate() If Me.NewRecord Then Creer_Selection End Sub Function Action_Bouton() Set Rs = Forms!frmEpi.Recordset Set CBBouton = Application.CommandBars.ActionControl If CBBouton Is Nothing Then Exit Function Select Case CBBouton.Parameter Case "Selection" StrEpiFabric = Left$(CBBouton.Text, InStr(CBBouton.Text, ",") - 1) Rs.FindFirst "EpiReference = '" & StrEpiFabric & "'" End Select End Function Function Remplir_Selection(CBBouton As CommandBarComboBox) StrSQL = "SELECT EpiFabric, EpiReference FROM tblEpi ORDER BY EpiReference" Set Db = CurrentDb Set Rs = Db.OpenRecordset(StrSQL) Rs.MoveFirst Do Until Rs.EOF CBBouton.AddItem Rs.Fields("EpiReference") & ", " & Rs.Fields("EpiFabric") Rs.MoveNext Loop Rs.MoveFirst Set CBBouton = Application.CommandBars(CB_Nom).Controls(Bt20) CBBouton.Text = Me!EpiReference & ", " & Me!EpiFabric End Function Function Creer_Selection() On Error Resume Next Set CBBouton = CommandBars(CB_Nom).Controls(Bt20) CBBouton.Delete Set CB = CommandBars.Add(CB_Nom) With CB Set CBBouton = .Controls.Add(msoControlComboBox) With CBBouton .Enabled = True .BeginGroup = True .Style = msoComboLabel .Width = 220 .Caption = Bt20 .OnAction = "=Action_Bouton()" .Parameter = "Selection" End With End With Call Remplir_Selection(CBBouton) End Function
Partager