Magic_Doctor
Board Regular
- Joined
- Mar 18, 2009
- Messages
- 56
Hello,
In a previous thread ("Class Module & KeyDown") I asked for help with a class module and KeyDown. GWteB gave me a solution that worked very well. I admit that at my level, everything is not necessarily clear. Anyway, I tried to adapt this solution for a GotFocus time. This is what I wrote:
1/ in ThisWorbook :
2/ in a class module whose name is "Classe_Combos":
Unfortunately, that doesn't work, ComboBoxes do not fill up. Where did I go wrong?
In a previous thread ("Class Module & KeyDown") I asked for help with a class module and KeyDown. GWteB gave me a solution that worked very well. I admit that at my level, everything is not necessarily clear. Anyway, I tried to adapt this solution for a GotFocus time. This is what I wrote:
1/ in ThisWorbook :
VBA Code:
Option Explicit
Private Type TTWbkStorage
Coll As Collection
End Type
Private this As TTWbkStorage
Sub Workbook_Open()
ExposeComboBoxEvents
End Sub
Private Sub ExposeComboBoxEvents()
Dim clsCbx As Classe_Combos
Dim oWs As Worksheet
Dim oCtl As Object
Set this.Coll = New Collection
For Each oWs In ThisWorkbook.Sheets
For Each oCtl In oWs.OLEObjects
If oCtl.progID = "Forms.ComboBox.1" Then
Set clsCbx = New Classe_Combos
clsCbx.Create argCBox:=oCtl.Object, argSht:=oWs, argCbxName:=oCtl.Name
this.Coll.Add clsCbx
End If
Next oCtl
Next oWs
End Sub
VBA Code:
Option Explicit
Private WithEvents CbxGroup As MSForms.ComboBox
Private Type TComboBoxProps
Name As String
HostSheet As Worksheet
End Type
Private this As TComboBoxProps
Friend Sub Create(ByVal argCBox As MSForms.ComboBox, ByVal argSht As Worksheet, ByVal argCbxName As String)
Set CbxGroup = argCBox
Set this.HostSheet = argSht
this.Name = argCbxName
End Sub
Private Sub CbxGroup_GotFocus(ComboName)
CreeListeDispo ComboName
End Sub
Sub CreeListeDispo(ComboName$)
'Update of the ComboBoxes, whose name begins with "ComboList" (prefix), of the "Données" sheet which draws all their items from the same database ("BD" sheet).
'Each item can only be chosen once in a single ComboBox; it automatically disappears from the lists of other ComboBoxes.
'In short, we cannot choose the same item several times.
'- ComboName : the name of the ComboBox
'BOISGONTIER / Magic_Doctor / job75
Dim f1 As Worksheet, f2 As Worksheet, c, liste As Scripting.Dictionary
Set f1 = Sheets("Données")
Set f2 = Sheets("BD")
Set liste = New Dictionary
'Copy of the data base in Sheets("BD") | alphabetical order of the copy | delete copy
With f2.Range("ListeItems").Offset(, 2)
.Value = .Offset(, -2).Value
.Sort .Cells, xlAscending, Header:=xlNo
For Each c In .Cells
If Len(c) Then liste(c.Value) = ""
Next
.ClearContents
End With
'We only take into account the ComboBoxes whose prefix is "ComboList"
'The selected item is eliminated from the dictionary so that it no longer appears in the lists of other ComboBoxes
For Each c In f1.OLEObjects
If TypeName(c.Object) = "ComboBox" And ExtractText(c.Name) = "ComboListe" Then _
If c.Name <> ComboName Then If liste.Exists(c.Object.Value) Then liste.Remove c.Object.Value
Next
f1.OLEObjects(ComboName).Object.List = liste.Keys
f1.OLEObjects(ComboName).Object.DropDown
End Sub