Problème combobox ajouter enregistrement
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.
Code:
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 |
Merci de votre aide
